Propiedades Psicométricas, AccionSalud UDP

Show code
script src = "https://ajax.googleapis.com/ajax/libs/jquery/3.4.1/jquery.min.js"
Show code
 $(document).ready(function() {
    $('body').prepend('<div class=\"zoomDiv\"><img src=\"\" class=\"zoomImg\"></div>');
    // onClick function for all plots (img's)
    $('img:not(.zoomImg)').click(function() {
      $('.zoomImg').attr('src', $(this).attr('src')).css({width: '100%'});
      $('.zoomDiv').css({opacity: '1', width: 'auto', border: '1px solid white', borderRadius: '5px', position: 'fixed', top: '50%', left: '50%', marginRight: '-50%', transform: 'translate(-50%, -50%)', boxShadow: '0px 0px 50px #888888', zIndex: '50', overflow: 'auto', maxHeight: '100%'});
    });
    // onClick function for zoomImg
    $('img.zoomImg').click(function() {
      $('.zoomDiv').css({opacity: '0', width: '0%'}); 
    });
  });
Show code
unlink('*_cache', recursive = TRUE)
load("__encuesta_rec_exp_post_crash.RData")

if(isTRUE(getOption('knitr.in.progress'))==T){
    clus_iter=5000
} else {
  input <- readline('¿Are you gonna run the dataset with the whole iterations? (Si/No): ')
  if(input=="Si"){
    clus_iter=10000
  } else {
    clus_iter=1000
  }
}
library(tm)
if(isTRUE(getOption('knitr.in.progress'))==T){
  input2 <- "todas"
} else {
    input2 <- "todas"
    input2 <- Corpus(VectorSource(input2))
    input2 <- tm_map(input2, tolower)
    input2 <- tm_map(input2,stripWhitespace)
    input2 <- gsub(" ","_",as.character(unlist(input2)[1]))
}
Show code
#evitar que ocupe curl
#options(renv.download.override = utils::download.file)


#arriba puse algunas opciones para que por defecto escondiera el código
#también cargue algunos estilo .css para que el texto me apareciera justificado, entre otras cosas.
local({r <- getOption("repos")
       r["CRAN"] <- "http://cran.r-project.org" 
       options(repos=r)
})

clipboard <- function(x, sep="\t", row.names=FALSE, col.names=TRUE){
     con <- pipe("xclip -selection clipboard -i", open="w")
     write.table(x, con, sep=sep, row.names=row.names, col.names=col.names)
     close(con)
}

`%>%` <- magrittr::`%>%`
copy_names <- function(x,row.names=FALSE,col.names=TRUE,dec=",",...) {
  library(dplyr)
  if(class(ungroup(x))[1]=="tbl_df"){
    if(options()$OutDec=="."){
      options(OutDec = dec)
      write.table(format(data.frame(x)),"clipboard",sep="\t",row.names=FALSE,col.names=col.names,...)
      options(OutDec = ".")
      return(x)
    } else {
      options(OutDec = ",")
      write.table(format(data.frame(x)),"clipboard",sep="\t",row.names=FALSE,col.names=col.names,...)
      options(OutDec = ",")
      return(x)    
    }
  } else {
    if(options()$OutDec=="."){
      options(OutDec = dec)
      write.table(format(x),"clipboard",sep="\t",row.names=FALSE,col.names=col.names,...)
      options(OutDec = ".")
      return(x)
    } else {
      options(OutDec = ",")
      write.table(format(x),"clipboard",sep="\t",row.names=FALSE,col.names=col.names,...)
      options(OutDec = ",")
      return(x)       
    }
  }
}  

if(!require(pacman)){install.packages("pacman")}

pacman::p_unlock(lib.loc = .libPaths()) #para no tener problemas reinstalando paquetes
knitr::opts_chunk$set(
    echo = TRUE,
    message = FALSE,
    warning = FALSE
)
#dejo los paquetes estadísticos que voy a utilizar

if(!require(plotly)){install.packages("plotly")}
if(!require(htmlwidgets)){install.packages("htmlwidgets")}
#if(!require(tidyverse)){install.packages("tidyverse")}
if(!require(gganimate)){install.packages("gganimate")}
if(!require(readr)){install.packages("readr")}
if(!require(stringr)){install.packages("stringr")}
if(!require(data.table)){install.packages("data.table")}
if(!require(DT)){install.packages("DT")}
if(!require(ggplot2)){install.packages("ggplot2")}
if(!require(lattice)){install.packages("lattice")}
if(!require(forecast)){install.packages("forecast")}
if(!require(zoo)){install.packages("zoo")}
if(!require(janitor)){install.packages("janitor")}
if(!require(rjson)){install.packages("rjson")}
if(!require(estimatr)){install.packages("estimatr")} 
if(!require(textreg)){install.packages("textreg")}
if(!require(sjPlot)){install.packages("sjPlot")}
if(!require(foreign)){install.packages("foreign")}
if(!require(tsModel)){install.packages("tsModel")}
if(!require(lmtest)){install.packages("lmtest")}
if(!require(Epi)){install.packages("Epi")}
if(!require(splines)){install.packages("splines")}
if(!require(vcd)){install.packages("vcd")}
if(!require(astsa)){install.packages("astsa")}
if(!require(MASS)){install.packages("MASS")}
if(!require(ggsci)){install.packages("ggsci")}
if(!require(Hmisc)){install.packages("Hmisc")}
if(!require(compareGroups)){install.packages("compareGroups")}
if(!require(dplyr)){install.packages("dplyr")}
if(!require(ggforce)){install.packages("ggforce")}
if(!require(doParallel)){install.packages("doParallel")}
if(!require(SCtools)){install.packages("SCtools")}
if(!require(rio)){install.packages("rio")}
if(!require(rbokeh)){install.packages("rbokeh")}
if(!require(altair)){install.packages("altair")}
if(!require(sqldf)){install.packages("sqldf")} 
if(!require(devtools)){install.packages("devtools")}
if(!require(skimr)){install.packages("skimr")}
if(!require(tm)){install.packages("tm")} 
if(!require(RColorBrewer)){install.packages("RColorBrewer")}
if(!require(psych)){install.packages("psych")}
if(!require(GPArotation)){install.packages("GPArotation")}
if(!require(mvtnorm)){install.packages("mvtnorm")}
if(!require(polycor)){install.packages("polycor")}
if(!require(MVN)){install.packages("MVN")}
if(!require(ggcorrplot)){install.packages("ggcorrplot")}
if(!require(radiant)){install.packages("radiant")}
if(!require(homals)){install.packages("homals")}
if(!require(nFactors)){install.packages("nFactors")}
if(!require(ggiraph)){install.packages("ggiraph")}
if(!require(factoextra)){install.packages("factoextra")}
if(!require(tidyverse)){install.packages("tidyverse")}
if(!require(lubridate)){install.packages("lubridate")}
if(!require(REdaS)){install.packages("REdaS")}
if(!require(jrt)){install.packages("jrt")}
package 'tidyr' successfully unpacked and MD5 sums checked
package 'jrt' successfully unpacked and MD5 sums checked

The downloaded binary packages are in
    C:\Users\andre\AppData\Local\Temp\RtmpALC5sf\downloaded_packages
Show code
if(!require(parameters)){install.packages("parameters")}
if(!require(lavaan)){install.packages("lavaan")}
if(!require(lavaan)){install.packages("lavaan")}
if(!require(semPlot)){install.packages("semPlot")}
if(!require(semTools)){install.packages("semTools")}
if(!require(random.polychor.pa)){install.packages("random.polychor.pa")}
if(!require(heatmaply)){install.packages("heatmaply")}

# Calculate the number of cores
#no_cores <- detectCores() - 1
##cl<-makeCluster(no_cores)
#registerDoParallel(cl)
# sudo apt -y install libfontconfig1-dev
# sudo apt-get install libxml2-dev
#Sys.setlocale(category = "LC_ALL", locale = "english")
#locale("es", decimal_mark = ",")


find_type <- function(x) {
  case_when(
    is.factor(x) ~ "factor",
    is.character(x) ~ "character",
    is.numeric(x) ~ "numeric",
    TRUE ~ "not sure"
  )
}

permute_icc <- function(x, y, n = 99) {
  actual <- ICCbare(x, y)
  nulls <- vector(length = length(n), mode = "numeric")
  for(i in seq_along(1:n)) {
    scrambled_x <- sample(x, length(x), replace = F)
    nulls[i] <- ICCbare(scrambled_x, y)
  }
  (sum(abs(nulls) > ifelse(actual > 0, actual, -actual)) + 1) / (n+1)
}

permute_tau <- function(x, y, n = 99) {
  actual <- GKtau(x, y)$tauxy
  nulls <- vector(length = length(n), mode = "numeric")
  for(i in seq_along(1:n)) {
    scrambled_x <- sample(x, length(x), replace = F)
    nulls[i] <- GKtau(scrambled_x, y)$tauxy
  }
  (sum(abs(nulls) > ifelse(actual > 0, actual, -actual)) + 1) / (n+1)
}

# to do:
## get p-values

eda <- function(x, plot = FALSE) {
  
  x <- as.data.frame(x)
  
  num_rows <- ncol(x)^2 - ncol(x)
  df <- tibble(var1 = vector(mode = "character", length = 1),
               var2 = vector(mode = "character", length = 1),
               statistic = vector(mode = "character", length = 1),
               value = vector(mode = "double", length = 1),
               p_value = vector(mode = "double", length = 1),
               n = vector(mode = "integer", length = 1))
  
  for(i in seq_along(1:ncol(x)))
    for(j in seq_along(1:ncol(x))) {
      if(i < j){
        # get type of columns i and j
        var_1_type <- find_type(x[,i])
        var_2_type <- find_type(x[,j])
        #print(paste("var1 type: ", var_1_type, "\nvar2 type: ", var_2_type, "\n\n"))
        
        x1 <- x[,i]
        x2 <- x[,j]
        
        # remove NAs for simplicity
        if(any(is.na(x1))){
          # get NA indicies
          ind <- which(is.na(x1))
          x1 <- x1[-ind]
          x2 <- x2[-ind]
        }
        
        if(any(is.na(x2))){
          # get NA indicies
          ind <- which(is.na(x2))
          x1 <- x1[-ind]
          x2 <- x2[-ind]
        }
        
        # make sure x1 and x2 are the same length
        stopifnot(length(x1) == length(x2))
        
        n <- length(x1)
        
        if(var_1_type == "numeric" & var_2_type == "numeric") {
          # run a correlation
          result <- cor.test(x1, x2)
          df <- add_row(df, 
                        var1 = names(x)[i],
                        var2 = names(x)[j],
                        statistic = "r",
                        value = result$estimate,
                        p_value = result$p.value,
                        n = n
          )
        } else if(var_1_type == "factor" & var_2_type == "numeric") {
          # run an ANOVA or t-test, depending on number of levels
          num_levels <- length(levels(x1))
          require(ICC)
          result <- ICCbare(x1, x2)
          p <- permute_icc(x1, x2)
          df <- add_row(df, 
                        var1 = names(x)[i],
                        var2 = names(x)[j],
                        statistic = "ICC",
                        value = result,
                        p_value = p,
                        n = n
          )
        } else if(var_1_type == "numeric" & var_2_type == "factor") {
          # run an ANOVA or t-test, depending on number of levels
          num_levels <- length(levels(x2))
          require(ICC)
          result <- ICCbare(x2, x1)
          p <- permute_icc(x2, x1)
          df <- add_row(df, 
                        var1 = names(x)[i],
                        var2 = names(x)[j],
                        statistic = "ICC",
                        value = result,
                        p_value = p,
                        n = n
          )
        } else if(var_1_type == "factor" & var_2_type == "factor") {
          require("GoodmanKruskal")
          # compute the GKtau statistic
          stat1 <- GKtau(x1, x2)$tauxy
          stat2 <- GKtau(x1, x2)$tauyx
          p1 <- permute_tau(x1, x2)
          p2 <- permute_tau(x2, x1)
          df <- add_row(df, 
                        var1 = names(x)[i],
                        var2 = names(x)[j],
                        statistic = "tau",
                        value = stat1,
                        p_value = p1,
                        n = n
          )
          df <- add_row(df, 
                        var1 = names(x)[j],
                        var2 = names(x)[i],
                        statistic = "tau",
                        value = stat2,
                        p_value = p2,
                        n = n
          )
        } else{
          # return an empty row
          df <- add_row(df, 
                        var1 = names(x)[i],
                        var2 = names(x)[j],
                        statistic = NA_character_,
                        value = NA_integer_,
                        p_value = NA_real_,
                        n = n
          )
        }
      }
    }
  if(plot == TRUE) {
    df[-1,] %>%
      filter(!is.na(value)) %>%
      unite(variables, var1, var2, sep = " by ") %>%
      mutate(`possibly significant` = if_else(p_value < 0.05, "significant", "NS")) %>%
      ggplot(aes(y = value, x = reorder(variables, value), color = `possibly significant`)) +
      geom_point() +
      coord_flip() +
      facet_wrap(~statistic, scales = "free") +
      theme_minimal() +
      scale_color_manual(values = c("#37454B", "#E84F22"))
  } else{
    df[-1,]
  }
  
}

#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#
ajusteAFC <- function (x) {as.data.frame(cbind("Modelo"=deparse(substitute(x)),
                    "gl"=round(lavaan::fitMeasures(x) ["df"],digits=3),
                    "WLS X2"=round(lavaan::fitMeasures(x)["chisq"],digits=3),
                    "CMIN/df"=round((lavaan::fitMeasures(x)["chisq"]/fitMeasures(x) ["df"]),digits=3),
                    "aGFI"=round(lavaan::fitMeasures(x)["agfi"],digits=3),
                    "GFI"=round(lavaan::fitMeasures(x)["gfi"],digits=3),
                    "RMSEA [90% IC]"=paste0(round(lavaan::fitMeasures(x) ["rmsea"],3),"[",round(lavaan::fitMeasures(x) ["rmsea.ci.lower"],3),"-",round(lavaan::fitMeasures(x) ["rmsea.ci.upper"],3),"]"),
                    "CFit"=round(lavaan::fitMeasures(x)["rmsea.pvalue"],digits=3),
                    "CFI"=round(lavaan::fitMeasures(x)["cfi"],digits=3),
                    "NNFI"=round(lavaan::fitMeasures(x)["nnfi"],digits=3)))

  
  return(
    as.data.frame(cbind("Modelo"=deparse(substitute(x)),
                    "gl"=round(lavaan::fitMeasures(x) ["df"],digits=3),
                    "WLS X2"=sprintf("%7.3f",round(lavaan::fitMeasures(x)["chisq"],digits=3)),
                    "CMIN/df"=sprintf("%5.3f",round((lavaan::fitMeasures(x)["chisq"]/fitMeasures(x) ["df"]),digits=3)),
                    "aGFI"=sprintf("%5.3f",round(lavaan::fitMeasures(x)["agfi"],digits=3)),
                    "GFI"=sprintf("%5.3f",round(lavaan::fitMeasures(x)["gfi"],digits=3)),
                    "RMSEA [90% IC]"=paste0(sprintf("%5.3f",round(lavaan::fitMeasures(x) ["rmsea"],3)),"[",sprintf("%5.3f",round(lavaan::fitMeasures(x) ["rmsea.ci.lower"],3)),"-",sprintf("%5.3f",round(lavaan::fitMeasures(x) ["rmsea.ci.upper"],3)),"]"),
                    "CFit"=sprintf("%5.3f",round(lavaan::fitMeasures(x)["rmsea.pvalue"],digits=3)),
                    "CFI"=sprintf("%5.3f",round(lavaan::fitMeasures(x)["cfi"],digits=3)),
                    "NNFI"=sprintf("%5.3f",round(lavaan::fitMeasures(x)["nnfi"],digits=3))))
  )
}

#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#

Fecha: 09 febrero, 2022

Propiedades Psicométricas

Modelo de medida

Adecuación Para Análisis Factoriales

Show code
meas_model<-encuesta_rec %>%dplyr::mutate_at(.vars=vars(comp_sos_1:superv_3),.funs = list(`num_sm`=~as.numeric(.)))%>%  dplyr::select(ends_with("num_sm")) 


options(knitr.kable.NA = '')
MVN::mvn(meas_model[complete.cases(meas_model),], subset = NULL, mvnTest = "mardia", covariance = TRUE, tol = 1e-25, alpha = 0.5,scale = FALSE, desc = TRUE, transform = "none", R = 1000,univariateTest = "Lillie",univariatePlot = "none", multivariatePlot = "none",multivariateOutlierMethod = "none", bc = FALSE, bcType = "rounded",showOutliers = FALSE, showNewData = FALSE)$multivariateNormality%>%
  data.frame()%>%
  dplyr::mutate(across(c("Statistic","p.value"),~ifelse(grepl("NA",.),NA_real_,as.numeric(as.character(.)))))%>%
  dplyr::mutate(Statistic=sprintf("%8.2f",Statistic))%>%
  dplyr::mutate(p.value=sprintf("%5.3f",p.value))%>%
  dplyr::mutate(across(c("Statistic","p.value"),~ifelse(grepl("NA",.),"-",as.character(.))))%>%
  dplyr::mutate(Result=ifelse(Result=="YES","Sí","No")) %>% 
   knitr::kable(.,format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Tabla. Normalidad Multivariada Preguntas sobre cómo te sientes"),
               col.names = c("Prueba","Estadistico","Valor p","Normalidad"),
align =c('l',rep('c', 101)))%>%
    kableExtra::add_footnote(c("Nota. Mardia Skewness= Asimetría Multivariante de Mardia (1970); Mardia Kurtosis= Curtosis Multivariante de Mardia (1970)",paste0("N= ",nrow(meas_model[complete.cases(meas_model),]))), notation = "none")%>%
  kableExtra::kable_classic() %>% 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 13)
(#tab:dim_total)Tabla. Normalidad Multivariada Preguntas sobre cómo te sientes
Prueba Estadistico Valor p Normalidad
Mardia Skewness 26778.45 0.000 No
Mardia Kurtosis 198.95 0.000 No
MVN
No
Nota. Mardia Skewness= Asimetría Multivariante de Mardia (1970); Mardia Kurtosis= Curtosis Multivariante de Mardia (1970)
N= 586
Show code
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#OPCS. CON DATOS== c("everything", "all.obs", "complete.obs", "na.or.complete", "pairwise.complete.obs"))
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
barlett<- function(x, complete="complete.obs"){
paste0("X2 de Barlett (", REdaS::bart_spher(x, use = complete)$`df`,",",REdaS::bart_spher(x, use = complete)$`n`,")= ",round(REdaS::bart_spher(x, use = complete)$`X2`,2),", p", ifelse(REdaS::bart_spher(x, use = complete)$`p.value`<.001,"<0.001",paste0("=",as.character(round(REdaS::bart_spher(x, use = complete)$`p.value`,3)))))
}

Sabemos que los datos no siguen una distribución normal, ¿pero existen correlaciones entre las variables en una proporción tal que haga pertinente un análisis factorial?. Para ello se efectuará una prueba de esfricidad de Barlett que permite identificar si la matriz de correlaciones es una matriz de identidad (no se identifican correlaciones). A partir de esta prueba se puede concluir que los datos son adecuados para el análisis factorial para el total de preguntas (X2 de Barlett (435,586)= 15075.06, p<0.001) (Barlett 1937).


La segunda prueba necesaria es la medida de adecuación de la muestra (MSA) de Kayser, Meyer & Olkin (KMO), que busca contrastar si la muestra es adecuada para llevar a cabo un análisis factorial (Lloret-Segura et al. 2014; Méndez Martínez and Rondón Sepúlveda 2012).


Show code
#LOS ARGUMENTOS DEBEN SER NUMÉRICOS, NO PUEDEN SER ORDINALES
#_#_#_#_#_#_#_#_#_#_#_
cbind(Modelos=c("Total de preguntas"),
      KMO=c(round(psych::KMO(na.omit(meas_model))$MSA,2))
      ) %>% 
   knitr::kable(.,format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Tabla. Keyser-Meyer-Olkin"),
               align =c('l',rep('c', 101)))%>%
   kableExtra::kable_classic() %>% 
    #kableExtra::add_footnote(c("Nota. Los ítems son")), notation = "none")%>%
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 13)  
(#tab:sm_kmo)Tabla. Keyser-Meyer-Olkin
Modelos KMO
Total de preguntas 0.97
Show code
#el índice Kaiser Meyer Olkin (KMO), el cual toma valores entre 0 y 1. La medida puede ser interpretada con distintos lineamientos; sin embargo, los más utilizados son: valores menores de 0,5 se consideran inaceptables; de 0,5 a 0,59, pobres; de 0,6 a 0,79, regulares, y de 0,8 a 1, meritorios. Este índice toma el valor de 1 solo en el caso de que una variable sea perfectamente predicha.
# Méndez Martínez, Carolina, & Rondón Sepúlveda, Martín Alonso. (2012). Introducción al análisis factorial exploratorio. Revista Colombiana de Psiquiatría, 41(1), 197-207. Retrieved February 24, 2021, from http://www.scielo.org.co/scielo.php?script=sci_arttext&pid=S0034-74502012000100014&lng=en&tlng=es.

A partir de la medida obtenida, se constata que la adecuación para el análisis es bastante adecuada, siendo los valores KMO para ítems individuales mayores a 0.7.


Lo anterior, puede corroborarse en los gráficos cuantil-cuantil presentados, en los que la línea roja representa una distirbución normal, mientras que los puntos azules reflejan la distribución presente en los datos, las cuales se superponen en el menor de los casos.


Show code
par(mfrow=c(8,4),mai=c(0.5,0.5,0.5,0))
for (k in 1:length(meas_model)) {
         car::qqPlot(meas_model[,k], col = "skyblue4",  main = names(meas_model)[k],xlab="Cuartiles Teóricos", ylab="Cuartiles Empíricos",id=F, col.lines="orange")
}
Figura S1. Gráficos Cuantil-Cuantil Ítems (intervalos de confianza en naranjo)

(#fig:fig1_naq_qq)Figura S1. Gráficos Cuantil-Cuantil Ítems (intervalos de confianza en naranjo)


Para poder ver la relación entre las respuestas entregadas, se generó una matriz de correlaciones policóricas que asume la naturaleza ordinal de las variables. Se estimaron sólo para aquellas observaciones que no tuvieran datos perdidos (complete.obs). Esta matriz estandariza las variables (particularmente importante cuando los ítems no tienen las mismas escalas de medición) (John Fox 2019).


Show code
#<div style="border: 1px solid #ddd; padding: 5px; overflow-y: scroll; height:600px; overflow-x: scroll; width:100%;">

require(polycor)
#max-height:150%; overflow: scroll;
#Computes a heterogenous correlation matrix, consisting of Pearson product-moment correlations between numeric variables, polyserial correlations between numeric and ordinal variables, and polychoric correlations between ordinal variables.

meas_model_original<-encuesta_rec %>%dplyr::mutate_at(.vars=vars(comp_sos_1:superv_3),.funs = list(`num_sm`=~as.numeric(.)))%>%  dplyr::select(ends_with("num_sm")) 

hetcor_mat<-hetcor(dplyr::select(encuesta_rec,comp_sos_1:superv_3), ML = T, std.err = T, use="complete.obs", bins=4, pd=TRUE)#smooth

# https://www.r-bloggers.com/2020/08/interactive-correlation-plot/

hetcor_mat_meas_mod_df<-
reshape2::melt(tibble::as_tibble(hetcor_mat$correlations,rownames = "rowname")) %>% 
  dplyr::left_join(melt(tibble::as_tibble(hetcor_mat$tests,rownames = "rowname")),by=c("rowname","variable"))%>%
  dplyr::rename("Var1"="rowname", "Var2"="variable", "corr"="value.x", "pval"="value.y") %>% 
  dplyr::mutate(Var1=factor(Var1, levels=paste0(var_labels_df[12:41,]$x,""))) %>% 
  dplyr::mutate(Var2=factor(Var2, levels=paste0(var_labels_df[12:41,]$x,""))) %>% 
  dplyr::left_join(dplyr::mutate(var_labels_df[12:41,],vars=paste0(x,"")), by=c("Var1"="vars")) %>% 
  dplyr::left_join(dplyr::mutate(var_labels_df[12:41,],vars=paste0(x,"")), by=c("Var2"="vars")) %>%
  dplyr::select(-x.x, -x.y) %>% 
  dplyr::rename("Var1_lab"="V2.x", "Var2_lab"="V2.y")

pd1 <- hetcor_mat_meas_mod_df %>% 
  dplyr::mutate(data_id = paste0(Var1, '-', Var2),
         tooltip = paste0('Y: ',Var1_lab, '<br>', 'X: ',Var2_lab, '<br>Rho: ', round(as.numeric(corr), 2), 
                          '<br>p', ifelse(pval<.001,"<0.001",paste0("=",sprintf("%.4f",pval)))))

p1 <- ggplot(pd1) +
  geom_tile_interactive(aes(Var2,Var1, fill = corr,
                            tooltip = tooltip
                            ), color = "gray")  +
  scale_fill_gradient2(low = "#E46726", high = "#6D9EC1",
                       mid = "white", midpoint = 0, limit = c(-1, 1), space = "Lab",
                       name = "Corr") +
  geom_text(mapping = aes(x = Var1, y = Var2, label = round(corr, 2)), size = 1.25) +
  ggplot2::coord_fixed() +
  theme_minimal() +
  theme(axis.text.x = element_blank())+
  theme(axis.text.y = element_blank())+
  guides(fill = FALSE) +
  xlab("") + ylab("")
girafe(ggobj = p1)

Figure 1: Figura 1. Matriz de Correlaciones Policóricas


Show code
cbind.data.frame(Modelos=c("Total de preguntas"),
                 rbind(psych::unidim(meas_model_original,cor= "poly")$uni))%>% 
  dplyr::select(`Modelos`,`u`,`Unidim.A`,`alpha`,`av.r`,`median.r`) %>% 
  dplyr::mutate_if(is.numeric, round, 2) %>% 
   knitr::kable(.,format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Tabla. Unidimensionalidad, Modelo de medida"),
               col.names = c("Modelos","Undimiensionalidad Cruda","Unidimensionalidad Ajustada","Alfa estandarizado","Promedio de la Correlación entre ítems (ICC)", "Mediana de la correlación entre ítems (ICC)"),
align =c('l',rep('c', 101)))%>%
  kableExtra::kable_classic() %>% 
    #kableExtra::add_footnote(c("Nota. Los ítems son")), notation = "none")%>%
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 13)  
(#tab:unidim_total)Tabla. Unidimensionalidad, Modelo de medida
Modelos Undimiensionalidad Cruda Unidimensionalidad Ajustada Alfa estandarizado Promedio de la Correlación entre ítems (ICC) Mediana de la correlación entre ítems (ICC)
Total de preguntas 0.97 1 0.98 0.63 0.62
Show code
# When finding pairwise correlations, should we use the global values of the tau parameter (which is somewhat faster), or the local values (global=FALSE)? The local option is equivalent to the polycor solution, or to doing one correlation at a time. global=TRUE borrows information for one item pair from the other pairs using those item's frequencies. This will make a difference in the presence of lots of missing data. With very small sample sizes with global=FALSE and correct=TRUE, the function will fail (for as yet underdetermined reasons.

##Koo and Li (2016) gives the following suggestion for interpreting ICC (Koo and Li 2016):
#below 0.50: poor
#between 0.50 and 0.75: moderate
#between 0.75 and 0.90: good
#above 0.90: excellent

A partir de la tabla anterior, se observa una alta unidimensionalidad, pero una discreta correlación intraclase. Téngase en cuenta que este es un análisis preliminar.


Análisis Factorial Exploratorio (AFE)

El análisis exploratorio utilizó la matriz de correlaciones policóricas especificada al principio. El objetivo fue identificar el número y composición de los factores comunes (variables latentes) necesarios para explicar la varianza común del conjunto de ítems, por lo que se incluye la comunalidad y la unicidad. Para determinar el número óptimo de factores interpretables (el número de factores cuya solución se ajuste mejor a los datos), se utilizó el criterio VSS (criterio de estructura más simple) y el MAP (mínimo parcial promedio o minimum average partial) de Velicer. Dicho criterio compara las cargas factoriales bajas, en comparación al modelo más simple, y a la vez considera la cantidad de casos. Para el presente modelo que asume observaciones completas en variables de salud mental, se estiman 586 casos.


Teniendo en cuenta el origen de los ítems, se compararon las estructuras de modelos que admitían desde 1 a 12 factores. Es necesario tener en consideración de que en ciencias sociales y en salud mental, muchas de las variables latentes a pesquisar podrían estar correlacionadas entre ellas, por lo que nunca serían del todo ortogonales en la práctica. Por dicha razón, se añadió una comparación considerando una rotación oblicua para efectos de este análisis. Por otra parte, reducir el número de ítems no es el objetivo primario del análisis, por lo que se descartó una rotación de tipo ortogonal, aunque la interpretación de sus cargas factoriales tienda a ser más simple que mediante una solución oblicua. Por último, se utilizó el método de extracción correspondiente a Factorización de Ejes Principales (Principal Axis Factoring), un método comunmente utilizado que no requiere cumplir con el supuesto de normalidad multivariada. El objetivo es conseguir la mejor estimación posible de las comunalidades a partir del número de factores retenidos (Lloret-Segura et al. 2014; Osborne, Costello, and Kellow 2008; Izquierdo, Olea, and Abad 2014).


Show code
# Anna B. Costello and Jason W. Osborne. 2005. Best practices in exploratory factor analysis: Four recommendations for getting the most from your analysis. Pract. Assess. Res. Eval. 10, 7 (2005), 1–9. Retrieved from http://pareonline.net/getvn.asp?v=10&n=7. 

# John K. Sakaluk and Stephen D. Short. 2017. A methodological review of exploratory factor analysis in sexuality research: Used practices, best practices, and data analysis resources. J. Sex Res. 54, 1 (2017), 1–9. DOI: https://doi.org/10.1080/00224499.2015.1137538 

# Roger L. Worthington and Tiffany A. Whittaker. 2006. Scale development research. Counsel. Psychol. 34, 6 ( Nov. 2006), 806–838. DOI: https://doi.org/10.1177/0011000006288127 

# Lloret-Segura, Susana, Ferreres-Traver, Adoración, Hernández-Baeza, Ana, & Tomás-Marco, Inés. (2014). El Análisis Factorial Exploratorio de los Ítems: una guía práctica, revisada y actualizada. Anales de Psicología, 30(3), 1151-1169. https://dx.doi.org/10.6018/analesps.30.3.199361

#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#

#Chi Square rule #1: Extracting factors until the chi square of the residual matrix is not significant.

#Chi Square rule #2: Extracting factors until the change in chi square from factor n to factor n+1 is not significant. Parallel Analysis: Extracting factors until the eigen values of the real data are less than the corresponding eigen values of a random data set of the same size.

#Scree Test: Plotting the magnitude of the successive eigen values and applying the scree test (a sudden drop in eigen values analogous to the change in slope seen when scrambling up the talus slope of a mountain and approaching the rock face).

#Eigen Value of 1 rule: Extracting principal components until the eigen value <1.
#Meaning: Extracting factors as long as they are interpetable.

#VSS: Using the Very Simple Structure Criterion.

#:#:#:#:#:#:#:#:#:#:#:

invisible(c("Compromiso Sostenible", "Desarrollo Profesional", "Liderazgo",  "Entorno de Trabajo", "Covid", "Intención de permanecer en la Compañía",  "Comunicación",  "Gestión del Desempeño",  "Compensación y Beneficios",  "Supervisor Inmediato"))

# Parallel analysis has been well documented to be a robust and accurate method for determining the number of factors to retain. Results from various studies have demonstrated that parallel analysis performed better than the widely used eigenvalue-greater-than-1.0 rule, the scree test, the maximum likelihood method, and the chi-square test

# Liu, O. L., & Rijmen, F. (2008). A modified procedure for parallel analysis of ordered categorical data. Behavior Research Methods, 40(2), 556–562. doi:10.3758/brm.40.2.556 
Show code
#Each of the procedures has its advantages and disadvantages. Using either the chi square test or the change in square test is, of course, sensitive to the number of subjects and leads to the nonsensical condition that if one wants to find many factors, one simply runs more subjects. Parallel analysis is partially sensitive to sample size in that for large samples the eigen values of random factors will be very small. The scree test is quite appealling but can lead to differences of interpretation as to when the scree "breaks". The eigen value of 1 rule, although the default for many programs, seems to be a rough way of dividing the number of variables by 3. Extracting interpretable factors means that the number of factors reflects the investigators creativity more than the data. VSS, while very simple to understand, will not work very well if the data are very factorially complex. (Simulations suggests it will work fine if the complexities of some of the items are no more than 2).

vss(hetcor_mat$correlations, n=12,n.obs=nrow(meas_model_original[complete.cases(meas_model_original),]), use="complete cases", rotate="oblimin", cor= "poly", fm="pa", plot=F)

Very Simple Structure
Call: vss(x = hetcor_mat$correlations, n = 12, rotate = "oblimin", 
    fm = "pa", n.obs = nrow(meas_model_original[complete.cases(meas_model_original), 
        ]), plot = F, use = "complete cases", cor = "poly")
VSS complexity 1 achieves a maximimum of 0.98  with  1  factors
VSS complexity 2 achieves a maximimum of 0.8  with  2  factors

The Velicer MAP achieves a minimum of 0.02  with  4  factors 
BIC achieves a minimum of  86.91  with  12  factors
Sample Size adjusted BIC achieves a minimum of  534.54  with  12  factors

Statistics by number of factors 
   vss1 vss2   map dof chisq     prob sqresid  fit RMSEA  BIC SABIC
1  0.98 0.00 0.037 405  6864  0.0e+00       8 0.98  0.16 4282  5568
2  0.73 0.80 0.026 376  4568  0.0e+00      77 0.80  0.14 2172  3365
3  0.50 0.66 0.020 348  3094  0.0e+00     130 0.66  0.12  876  1981
4  0.29 0.43 0.019 321  2595  0.0e+00     183 0.53  0.11  549  1568
5  0.25 0.37 0.020 295  2382 1.9e-322     197 0.49  0.11  502  1438
6  0.18 0.29 0.023 270  2065 1.8e-273     212 0.45  0.11  344  1201
7  0.18 0.26 0.025 246  1790 3.5e-232     218 0.44  0.10  222  1003
8  0.17 0.24 0.030 223  1676 9.7e-221     227 0.42  0.11  254   962
9  0.14 0.21 0.032 201  1413 4.9e-181     235 0.39  0.10  132   770
10 0.15 0.19 0.035 180  1280 4.3e-165     236 0.39  0.10  133   704
11 0.14 0.18 0.039 160  1147 9.7e-149     241 0.38  0.10  127   635
12 0.14 0.18 0.042 141   986 1.1e-126     246 0.37  0.10   87   535
   complex eChisq   SRMR eCRMS  eBIC
1      1.0   2220 0.0660 0.068  -361
2      1.1    877 0.0415 0.045 -1520
3      1.3    414 0.0285 0.032 -1804
4      1.4    281 0.0235 0.027 -1765
5      1.5    216 0.0206 0.025 -1665
6      1.9    163 0.0179 0.023 -1558
7      2.1    127 0.0158 0.021 -1441
8      2.1    101 0.0141 0.020 -1320
9      2.1     76 0.0122 0.018 -1205
10     2.3     58 0.0107 0.017 -1089
11     2.4     46 0.0095 0.016  -973
12     2.3     36 0.0084 0.015  -863
Show code
vss(hetcor_mat$correlations, n=12,n.obs=nrow(meas_model_original[complete.cases(meas_model_original),]), use="complete cases", rotate="oblimin",cor= "poly", fm="pa", plot=T,title="Estructura Muy Simple, \nFactrización de Eje Principales, Rotación Oblicua")
Figura 3. Estructura Simple Matriz Policórica

(#fig:vss_tot_2)Figura 3. Estructura Simple Matriz Policórica


Very Simple Structure of  Estructura Muy Simple, 
Factrización de Eje Principales, Rotación Oblicua 
Call: vss(x = hetcor_mat$correlations, n = 12, rotate = "oblimin", 
    fm = "pa", n.obs = nrow(meas_model_original[complete.cases(meas_model_original), 
        ]), plot = T, title = "Estructura Muy Simple, \nFactrización de Eje Principales, Rotación Oblicua", 
    use = "complete cases", cor = "poly")
VSS complexity 1 achieves a maximimum of 0.98  with  1  factors
VSS complexity 2 achieves a maximimum of 0.8  with  2  factors

The Velicer MAP achieves a minimum of 0.02  with  4  factors 
BIC achieves a minimum of  86.91  with  12  factors
Sample Size adjusted BIC achieves a minimum of  534.54  with  12  factors

Statistics by number of factors 
   vss1 vss2   map dof chisq     prob sqresid  fit RMSEA  BIC SABIC
1  0.98 0.00 0.037 405  6864  0.0e+00       8 0.98  0.16 4282  5568
2  0.73 0.80 0.026 376  4568  0.0e+00      77 0.80  0.14 2172  3365
3  0.50 0.66 0.020 348  3094  0.0e+00     130 0.66  0.12  876  1981
4  0.29 0.43 0.019 321  2595  0.0e+00     183 0.53  0.11  549  1568
5  0.25 0.37 0.020 295  2382 1.9e-322     197 0.49  0.11  502  1438
6  0.18 0.29 0.023 270  2065 1.8e-273     212 0.45  0.11  344  1201
7  0.18 0.26 0.025 246  1790 3.5e-232     218 0.44  0.10  222  1003
8  0.17 0.24 0.030 223  1676 9.7e-221     227 0.42  0.11  254   962
9  0.14 0.21 0.032 201  1413 4.9e-181     235 0.39  0.10  132   770
10 0.15 0.19 0.035 180  1280 4.3e-165     236 0.39  0.10  133   704
11 0.14 0.18 0.039 160  1147 9.7e-149     241 0.38  0.10  127   635
12 0.14 0.18 0.042 141   986 1.1e-126     246 0.37  0.10   87   535
   complex eChisq   SRMR eCRMS  eBIC
1      1.0   2220 0.0660 0.068  -361
2      1.1    877 0.0415 0.045 -1520
3      1.3    414 0.0285 0.032 -1804
4      1.4    281 0.0235 0.027 -1765
5      1.5    216 0.0206 0.025 -1665
6      1.9    163 0.0179 0.023 -1558
7      2.1    127 0.0158 0.021 -1441
8      2.1    101 0.0141 0.020 -1320
9      2.1     76 0.0122 0.018 -1205
10     2.3     58 0.0107 0.017 -1089
11     2.4     46 0.0095 0.016  -973
12     2.3     36 0.0084 0.015  -863
Show code
invisible(c("Haciéndolo con todos los datos estandarizados"))
#vss(data.matrix(dim_sm_p345_original) %>%  standardize(), n=6,n.obs=nrow(dim_sm_p345_original[complete.cases(dim_sm_p345_original),]), use="complete cases", rotate="oblimin",cor= "poly", fm="pa", plot=T,title="Estructura Muy Simple, \nFactrización de Eje Principales, Rotación Oblicua")

invisible(c("Haciéndolo con todos la matriz policórica obtenida por el paquete hetcor"))
#vss(hetcor_mat$correlations, n=6,n.obs=nrow(dim_sm_p345_original[complete.cases(dim_sm_p345_original),]), use="complete cases", fm="pa", plot=T,title="Estructura Muy Simple, \nFactrización de Eje Principales, Rotación Oblicua")


#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#FUENTES:

# https://stats.stackexchange.com/questions/32669/vss-criterion-for-the-number-of-factors-in-rs-psych-package
# http://search.r-project.org/R/library/psych/html/VSS.html
# https://it.unt.edu/sites/default/files/vss_l_jds_dec2014.pdf
# http://dwoll.de/rexrepos/posts/multFApoly.html
#n is the maximum number of factors to extract  (default is 8)
#rotate is a string "none" or "varimax" for type of rotation (default is "none"
#:#:#:#:#:#:
#How to find the correlations: "cor" is Pearson", "cov" is covariance, "tet" is tetrachoric, "poly" is polychoric, "mixed" uses mixed cor for a mixture of tetrachorics, polychorics, Pearsons, biserials, and polyserials, Yuleb is Yulebonett, Yuleq and YuleY are the obvious Yule coefficients as appropriate

# It will produce normal factor analysis output but also will save the polychoric matrix (rho) and items difficulties (tau) for subsequent irt analyses.

#FUENTES
## http://www.psicothema.com/pdf/4206.pdf


A partir de los resultados expuestos, el criterio VSS establece claramente que el modelo de un factor parece bastante razonable, al igual que el MAP (Ruscio & Roche, 2012). De todas formas, un criterio no absoluto (relativo) como el BIC establece que los datos podrían perfectamente ajustarse a una estructura factorial de 4 factores (Cattell 1966).


Show code
VSS.scree(hetcor_mat$correlations, main="")
Figura 3. Gráfico de Codo de Catell,  Matriz Policórica

(#fig:rpoly_pa_tot)Figura 3. Gráfico de Codo de Catell, Matriz Policórica

Show code
#Es tal vez la técnica más utilizada. El aporte se mide con los valores propios, que representan el total de varianza explicada por el factor. El criterio utilizado para su uso se basa en tomar para el análisis solo aquellos factores que tengan valores propios mayores a 1
# Al igual que en el criterio anterior, depende de los valores propios, pero se diferencia porque los valores son graficados y se hace un análisis visual buscando en la curva un punto de inflexión donde esta cambie de sentido o de concavidad. Un problema que puede llegar a presentar es ser muy subjetivo y, por lo tanto, depender básicamente del criterio del investigador. No se recomienda cuando el número de variables en análisis es muy alto y la contribución de los nuevos ítems es similar 

# Méndez Martínez, Carolina, & Rondón Sepúlveda, Martín Alonso. (2012). Introducción al análisis factorial exploratorio. Revista Colombiana de Psiquiatría, 41(1), 197-207. Retrieved February 24, 2021, from http://www.scielo.org.co/scielo.php?script=sci_arttext&pid=S0034-74502012000100014&lng=en&tlng=es.


Lo anterior se corroboró mediante un gráfico de codo simple, el cual arrojó valores propios (eigenvalues) superiores a 1 exclusivamente para el modelo que asumió 1 factor. Adicionalmente, se generó un análisis mediante otro programa (random.polychor.pa), el que permite comparar distintos distintas cantidades de variables latentes, en base a matrices policóricas simuladas. Una comparación de los valores únicos de la muestra permite comparar cuáles superan a los datos aleatorios. Se generaron 500 muestras aleatorias, el programa trabaja sólo con casos completos y sólo se consideran factores no-aleatorios los que superan el percentil 99 (Presaghi and Desimoni 2015).


Show code
# Presaghi, Fabio & Desimoni, Marta. (2015). Title A Parallel Analysis With Polychoric Correlation Matrices. 10.13140/RG.2.1.4380.2640. 

random.polychor.pa(data.matrix=data.matrix(meas_model_original), nrep=500, q.eigen=0.99, r.seed=1234)
***** RESULTS FOR PARALLEL ANALYSIS ***** 
*** computation starts at: 20:13:45 
*** number of units (rows) in data.matrix: 586 
*** No missing values found 
*** SINGLE sample Parallel Analysis 
*** simulation method: RANDOM 
*** distribution: UNIFORM 
*** difficulty factor: FALSE 
*** correction for continuity set to: 0.0 
*** number of variables (cols) in data.matrix: 30 
*** Groups of items with diffent number of categories found in your data.matrix: 
        Items Categories Min.Cat Max.Cat
1 GROUP    30          5       1       5

Computations for sub-sample:  1 
 The first simulation for FA took: 4.523 secs.
25 % - 50 % - 75 % - 100 % completed!
 The first simulation for PCA took: 3.783 secs.
25 % - 50 % - 75 % - 100 % completed!
computation ended at: 21:18:44 
Elapsed Time: 65 mins 

 Comparison between RANDOM eigenvalues and EMPIRICAL eigenvalues 

******* RESULTS for PARALLEL ANALYSIS:  
                                                                 sample.1
# of factors (PCA) for Velicer MAP criterium (Pearson corr)...:         4
# of factors (PCA) for Velicer MAP(4th power)(Polychoric corr):         4
# of factors (PCA) for Velicer MAP criterium (Polychoric corr):         4
# of factors (PCA) for Velicer MAP(4th power)(Pearson corr)...:         4
# of factors (PCA) for PA method (Polychoric Corr.)...........:         5
# of factors (PCA) for PA method (Pearson Corr.)..............:         5
# of factors for PA method (Polychoric Corr.).................:         5
# of factors for PA method (Pearson Corr.)....................:         5
Figura 4. Gráfico de Codo,  Matriz Policórica

(#fig:random_polychor_pa_tot)Figura 4. Gráfico de Codo, Matriz Policórica

Show code
#This means that the function guarantees that the empirical and the simulated data matrix are similar, but this also means that by changing the sample of participants the simulated data will change (even if slightly).

#The function will extract the eigenvalues from each randomly generated polychoric matrices and the requested percentile is returned. Eigenvalues from polychoric correlation matrix obtained from real data is also compute and compared, in a (scree) plot, with the eigenvalues extracted from the simulation (Polychoric matrices). Recently, Cho, Li & Bandalos (2009) showed that, in using PA method, it is important to match the type of the correlation matrix used to recover the eigenvalues from real data with the type of correlation matrix used to estimate random eigenvalues. Crossing the type of correlations (using Polychoric correlation matrix to estimate real eigenvalues and random simulated Pearson correlation matrices) may result in a wrong decision (i.e., retaining more non-random factors than the needed). A comparison with eigenvalues extracted from both randomly simulated Pearson correlation matrices and real data is also included. Finally, for both type of correlation matrix (Polychoric vs Pearson), the two versions (the classic squared coefficient and the 4th power coefficient) of Velicer's MAP criterion are calculated (Velicer, 1976; Velicer, Eaton, & Fava, 2000) by implementing under R the code released by O'Connor (2000) for SPSS, SAS and MATLAB. As the poly.mat() function used to calculate the polychoric correlation matrix is going to be deprecated in favour of polychoric() function, the random.polychor.pa was consequently updated (version 1.1.2) to account for changes in psych() package.

#FUENTE:
### https://www.rdocumentation.org/packages/random.polychor.pa/versions/1.1.3.1/topics/random.polychor.pa
### https://stats.stackexchange.com/questions/31948/looking-for-a-step-through-an-example-of-a-factor-analysis-on-dichotomous-data

#:#:#::#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
invisible("IMPORTANTE PENSAR QUE NO SE SI LA CORRECCIÖN DE CONTINUIDAD QUE USA HETCOR VALE CONSERVARLA")
#https://stackoverflow.com/questions/59167406/hetcor-can-one-add-a-correction-for-continuity
#https://stackoverflow.com/questions/59167406/hetcor-can-one-add-a-correction-for-continuity

#The continuity parameter is passed to polychoric() function to handle the correction for continuity. In polychoric() function this correction for continuity is set by default to .5 (i.e. correct=TRUE). However in some cases this correction for continuity causes the polychorich() function to stop unexpectedly and consequently also random.polychor.pa() stops. So we added this parameter to allow users to bypass this problem. This parameter is set by default to 0.0 (i.e., no correction for continuity applied) and user may add the correction for continuity by setting the value to 0.5.

#random.polychor.pa(data.matrix=data.matrix(dim_sm_p345), nrep=500, q.eigen=0.99, r.seed=1234,continuity=0.5)

#this parameter allows to choose between uniform (that is also the default) or multinomial distribution for the simulation of random data sets.


A partir de la Tabla anterior, se encontró que una solución de 5 y 4 subdimensiones también es razonable. De todas formas, se compararon los índices de ajuste de distintas soluciones factoriales, que asumen desde 1 hasta 12 variables latentes.


Show code
fa.parallel(polychoric(data.matrix(dplyr::select(encuesta_rec,comp_sos_1:superv_3)))$rho, fm="pa", fa="fa", main = "Scree Plot",n.obs=nrow(meas_model_original[complete.cases(meas_model_original),]), plot=F)
Parallel analysis suggests that the number of factors =  4  and the number of components =  NA 


Show code
  library(psych)
 library(GPArotation)
 library(dplyr)
 library(plyr)
 library(knitr)

 efas <- list()

 for (i in 1:12) {
     fitn <- psych::fa(meas_model_original,
          nfactors= i, 
          cor= "poly", 
          fm= "pa", 
          use="complete.obs", 
          n.obs= nrow(meas_model_original[complete.cases(meas_model_original),]),
          #n.iter=500, 
          rotate="oblimin")
     efas[[i]] <- data.frame(fitn$TLI, fitn$RMSEA[1], fitn$RMSEA[2], fitn$RMSEA[3], fitn$rms, fitn$BIC) %>% 
     mutate(Factors = i,
            RMSEA_ci = paste0(sprintf("%2.2f", fitn.RMSEA.2.),", ",sprintf("%2.2f", fitn.RMSEA.3.))) %>% 
     dplyr::rename(TLI = fitn.TLI,
            RMSEA = fitn.RMSEA.1.,
            "RMSEA CI90%" = RMSEA_ci,
            SRMR = fitn.rms, 
            BIC = fitn.BIC) %>% 
     dplyr::select(Factors, TLI, RMSEA, "RMSEA CI90%", SRMR, BIC)
     }

do.call("rbind", efas)  %>%
   data.table::data.table(keep.rownames = F) %>% 
   dplyr::mutate_at(c(2,3,5),~round(as.numeric(.),2)) %>% 
   dplyr::mutate_at(c(6),~round(as.numeric(.),0)) %>% 
  knitr::kable(format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Tabla. Comparación de Índices de Ajuste, Preguntas sobre Salud Mental"),
               #col.names = c("Prueba","Estadistico","Valor p","Normalidad"),
align =c('l',rep('c', 101)))%>%
    kableExtra::add_footnote(c("Nota. TLI= Tucker-Lewis Index; RMSEA= Root Mean Square Error of Approximation; SRMR= Standardized Root Mean Residual; BIC= Bayesian Information Criterion"), notation = "none")%>%
  kableExtra::kable_classic() %>% 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12)
(#tab:fa_sm_0_comp_modelos)Tabla. Comparación de Índices de Ajuste, Preguntas sobre Salud Mental
Factors TLI RMSEA RMSEA CI90% SRMR BIC
1 0.70 0.16 0.16, 0.16 0.07 3,988
2 0.79 0.13 0.13, 0.14 0.04 1,926
3 0.85 0.11 0.11, 0.12 0.03 678
4 0.87 0.11 0.10, 0.11 0.02 358
5 0.87 0.10 0.10, 0.11 0.02 320
6 0.88 0.10 0.10, 0.11 0.02 178
7 0.89 0.10 0.09, 0.10 0.02 77
8 0.88 0.10 0.10, 0.10 0.01 102
9 0.89 0.10 0.09, 0.10 0.01 4
10 0.89 0.10 0.09, 0.10 0.01 19
11 0.89 0.10 0.09, 0.10 0.01 25
12 0.89 0.10 0.09, 0.10 0.01 -5
Nota. TLI= Tucker-Lewis Index; RMSEA= Root Mean Square Error of Approximation; SRMR= Standardized Root Mean Residual; BIC= Bayesian Information Criterion


El error anterior nos muestra que deja de ser operacionalmente factible asumir más de 6 variables latentes (es necesario considerar que la prueba contrastada se compone de 13 ítems). A partir de la tabla anterior, el modelo que exhibe mejores índices de ajuste es el que asume 6 factores, seguido por el de 5. De todas formas, analizaremos las cargas factoriales. Atendiendo a que algunas variables latentes podrían estar compuestas sólo por 2 ítems, se hace mucho más necesario contar con mayores cargas factoriales por la variable de interés, sumado a menores cagas factoriales cruzadas (Treiblmaier and Filzmoser 2010).


Show code
invisible("Las páginas recomiendan no hacerlo con la matri de correlaciones. asta con la numérica")

modelo_10_factores <-
psych::fa(meas_model_original,
          nfactors= 10, 
          cor= "poly", 
          fm= "pa", 
          use="complete.obs", 
          n.obs= nrow(meas_model_original[complete.cases(meas_model_original),]),
          n.iter=500, 
          rotate="oblimin")

modelo_4_factores <-
psych::fa(meas_model_original,
          nfactors= 4, 
          cor= "poly", 
          fm= "pa", 
          use="complete.obs", 
          n.obs= nrow(meas_model_original[complete.cases(meas_model_original),]),
          n.iter=500, 
          rotate="oblimin")

#En el caso de las rotaciones oblicuas, se parte del supuesto de correlación entre los nuevos factores, que en la vida real es el escenario más común, lo que conduce a que las ponderaciones calculadas no coincidan con las correlaciones entre el factor y la variable. Dentro de los métodos de rotación oblicua más utilizados se encuentran el oblimin y el promax. La rotación oblimin permite establecer relaciones jerárquicas entre los factores, para lo cual debe establecer el grado de inclinación (δ) entre ellos. Un valor δ de cero da las rotaciones más oblicuas (3,5).

#En cuanto a la rotación promax, modifica los resultados de una rotación ortogonal hasta crear una solución con cargas factoriales lo más próximas posible a la "estructura ideal". Para ello, eleva las cargas factoriales obtenidas en una rotación ortogonal a una determinada potencia (conocida como κ). En general, los valores de κ se encuentran entre 2 y 4, pero, a mayor potencia, mayor oblicuidad en la solución (el valor de κ más común es de 4) (3,5).

# Méndez Martínez, Carolina, & Rondón Sepúlveda, Martín Alonso. (2012). Introducción al análisis factorial exploratorio. Revista Colombiana de Psiquiatría, 41(1), 197-207. Retrieved February 24, 2021, from http://www.scielo.org.co/scielo.php?script=sci_arttext&pid=S0034-74502012000100014&lng=en&tlng=es.

#:#:#:#:#:#:#:#:#:#:#:#:#:#:
# The Root Mean Square Error of Approximation (RMSEA) provides information as to how well the model, with unknown but optimally chosen parameter estimates, would fit the population covariance matrix (Byrne, 1998).
# One of its key advantages is that the RMSEA calculates confidence intervals around its value.
# Values below .060 indicate close fit (Hu & Bentler, 1999). Values up to .080 are commonly accepted as adequate.
# The Standardized Root Mean Residual (SRMR) is the square root of the difference between the residuals of the sample covariance matrix and the hypothesized covariance model.
# As SRMR is standardized, its values range between 0 and 1. Commonly, models with values below .05 threshold are considered to indicate good fit (Byrne, 1998). Also, values up to .08 are acceptable (Hu & Bentler, 1999).
# TLI’s values may fall below zero or be above one (Hair et al., 2013). For CFI and TLI values above .95 are indicative of good fit (Hu & Bentler, 1999). In practice, CFI and TLI values from .90 to .95 are considered acceptable.


#Hair, R. D., Black, W. C., Babin, B. J., Anderson, R. E., & Tatham, R. L. (2013). Multivariate data analysis. Englewood Cliffs, NJ: Prentice–Hall.

#:#:#:#:#:#:#:#:#:#:#:#:#:#:
# Situaciones en que las saturaciones sean bajas (menor de .40) y el número de ítems por factor también sea bajo (3 ítems) requieren tamaños muestrales mayores para tener alguna garantía de generalización de los resultados. Como es habitual utilizar muestras de conveniencia hay que tener en cuenta dos problemas: la no-representatividad y la atenuación por restricción de rango.
# Lloret-Segura, Susana, Ferreres-Traver, Adoración, Hernández-Baeza, Ana, & Tomás-Marco, Inés. (2014). El Análisis Factorial Exploratorio de los Ítems: una guía práctica, revisada y actualizada. Anales de Psicología, 30(3), 1151-1169. https://dx.doi.org/10.6018/analesps.30.3.199361

modelo_cargas_fac <-
data.frame(matrix(as.numeric(loadings(modelo_10_factores)), attributes(loadings(modelo_10_factores))$dim, dimnames=attributes(loadings(modelo_10_factores))$dimnames))%>%
  dplyr::mutate_at(1:dim(loadings(modelo_10_factores))[2], ~round(as.numeric(.),2)) %>% 
  dplyr::mutate_at(1:dim(loadings(modelo_10_factores))[2], ~ifelse(.<.3,"-",as.character(.))) %>% 
  data.table::data.table(keep.rownames = T) %>% 
  dplyr::mutate(Var1=factor(rn, levels=paste0(var_labels_df[12:41,]$x,"_num_sm"),labels=var_labels_df[12:41,]$V2))%>% 
  dplyr::select("Var1",paste0("PA",1:attributes(loadings(modelo_10_factores))$dim[2])) 


colnames(modelo_cargas_fac)<- c("Vars",paste0(paste0("PA",1:attributes(loadings(modelo_10_factores))$dim[2]),"\nR$^{2}$",round(modelo_10_factores$R2,2)))

modelo_cargas_fac %>% 
  knitr::kable(format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Tabla. Cargas factoriales, Modelo de 10 factores Total de Preguntas"),
               escape = T,
               #col.names = c("Prueba","Estadistico","Valor p","Normalidad"),
align =c('l',rep('c', 101)))%>%
  kableExtra::add_footnote(c("Nota. Se omiten cargas factoriales menores a .3"), notation = "none")%>% 
  kableExtra::kable_classic() %>% 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12)
(#tab:fa_sm_1)Tabla. Cargas factoriales, Modelo de 10 factores Total de Preguntas
Vars PA1 R${2}\(0.98 </th> <th style="text-align:center;"> PA2 R\){2}\(0.97 </th> <th style="text-align:center;"> PA3 R\){2}\(0.92 </th> <th style="text-align:center;"> PA4 R\){2}\(1.03 </th> <th style="text-align:center;"> PA5 R\){2}\(0.87 </th> <th style="text-align:center;"> PA6 R\){2}\(0.84 </th> <th style="text-align:center;"> PA7 R\){2}\(0.88 </th> <th style="text-align:center;"> PA8 R\){2}\(0.76 </th> <th style="text-align:center;"> PA9 R\){2}\(0.65 </th> <th style="text-align:center;"> PA10 R\){2}$0.61
Entiendo cómo mi trabajo contribuye a la consecución de los objetivos de esta empresa
0.79
Recomendaría esta empresa como un buen lugar para trabajar
Estoy dispuesto a realizar un esfuerzo mayor del que cabría esperar normalmente para contribuir al éxito de esta empresa
0.31
Dispongo de las herramientas y los recursos necesarios para lograr la excelencia en el rendimiento
0.55
Sé lo que se espera de mí en mi trabajo
0.34
Mi trabajo me ofrece la oportunidad de enfrentarme a nuevos desafíos
0.96
Las personas con las que trabajo por lo general se llevan bien entre sí
0.32
Mi trabajo me aporta una sensación de realización personal
0.44
Puedo mantener el nivel de energía que necesito durante toda la jornada laboral
0.36
Creo que permanecer en esta empresa es lo mejor para mí desde el punto de vista profesional y personal
0.51
La formación que he recibido me ha preparado adecuadamente para el trabajo que hago
0.69
Dispongo de suficientes oportunidades de recibir formación para mejorar mis habilidades en mi trabajo actual
0.77
Soy optimista respecto al futuro de esta empresa
Tengo confianza en las decisiones que toma el equipo directivo de esta empresa 0.33
Mi responsable directo se preocupa realmente por mí como empleado
0.87
Me siento cómodo con los valores de esta empresa
0.38
Confío en que nuestros líderes respondan eficazmente a los desafíos de negocio derivados del coronavirus.
0.74
Siento que la compañía me está protegiendo durante este tiempo.
0.89
Confío en nuestros líderes para proteger la salud y el bienestar de los empleados en este momento.
0.95
Esta organización está haciendo un excelente trabajo manteniendo a los empleados informados sobre los asuntos importantes que nos afectan durante este tiempo.
0.75
Considero que seguiré trabajando en la empresa en los próximos dos años
0.43
En esta empresa se hacen esfuerzos suficientes por conocer las opiniones e ideas de los empleados
0.33
Tengo acceso a la información necesaria para hacer bien mi trabajo
0.43
Recibo feedback sobre mi rendimiento con regularidad.
0.55
Según mi experiencia, en esta empresa se reconoce la excelencia en el rendimiento.
El programa de beneficios sociales de esta organización satisface mis necesidades
0.75
Creo que mi remuneración es competitiva si la comparamos con la de personas que desempeñan un trabajo similar en otras empresas
0.63
Mi responsable directo hace una buena labor fomentando el trabajo en equipo
0.91
Mi responsable directo me reconoce el trabajo bien hecho
0.92
Mi responsable directo fomenta el desarrollo de los empleados
0.86
Nota. Se omiten cargas factoriales menores a .3


Cuidado: Si bien las interpretaciones aquí planteadas están formuladas en términos positivos, también pueden interpretarse en términos negativos (falta, ausencia, etc.) o inversamente proporcionales (a mayor uno, menor otro).

De acuerdo a lo observado en la tabla anterior, el Compromiso Sostenible no se observa como una dimensión íntegra. No obstante, se desprende la relación que tiene el confiar en las decisiones de los directivos, la comidad con los valores de la empresa y recomendarla como un buen lugar para trabajar. El segundo factor detectado podría denominarse Supervisión aunque el primer ítem de Gestión del Desempeño tiende a confundirse con esta dimensión, al igual que el primer ítem de Entorno de trabajo. De lo anterior se desprende que una preocupación por parte del responsable directo y recibir feedback sobre su rendimiento tienen a relacionarse fuertemente con esta dimensión. La tercera subdimensión abarca COVID-19 en su totalidad, aunque se observa cuierta confusión con el segundo ítem de Entorno de trabajo. De lo anterior se desprende que en la percepción de la protección de los empleados por COVID-19 se asocian fuertemente a los valores que se perciben de la empresa. La cuarta subdimensión engloba principalmente el Desarrollo profesional, salvo por el primer ítem, más el cuarto ítem de Compromiso sostenible. De ello se desprende que teniendo la información necesaria para hacer bien el trabajo y percibiendo que la empresa reconoce la excelencia del rendimiento, se relaciona con disponer las herramientas y recursos para lograr la excelencia, se relaciona con la formación recibida y las oportunidades percibidas para recibirla. La quinta subdimensión identifica la dimensión de Compensaciones y benedificos, las que se ven contaminados por el primer ítem de Comunicación y el último de Compromiso sostenible. Se desprende que el mantener la energía durante la jornada laboral y percibir que en la empresa se hacen esfuerzos suficientes por conocer las opinionese ideas de los empleados se relaciona fuertemente con una percepción favorable del programa de beneficios sociales y percibir una remuneración competitiva. La sexta subdimensión aludiría a preguntas sobre Compromiso sostenible relacionadas con la definiciones de roles, la oportunidad de nuevos desafíos y la percepción de autorrealización en el trabajo. Conceptualmente es difícil de interpretar, aunque podría descartarse el primer ítem por estar bastante confundido con otra subdimensión. La séptima subdimenión apunta a entender la contribución que hace el trabjo y la disposición y el compromiso a la empresa, aunque la primera confundido fuertemente por la definición de roles.


Al margen de esto, téngase en cuenta que este modelo tiene malos niveles de ajuste


Show code
modelo_cargas_fac2 <-
data.frame(matrix(as.numeric(loadings(modelo_4_factores)), attributes(loadings(modelo_4_factores))$dim, dimnames=attributes(loadings(modelo_4_factores))$dimnames))%>%
  dplyr::mutate_at(1:dim(loadings(modelo_4_factores))[2], ~round(as.numeric(.),2)) %>% 
  dplyr::mutate_at(1:dim(loadings(modelo_4_factores))[2], ~ifelse(.<.3,"-",as.character(.))) %>%  data.table::data.table(keep.rownames = T) %>% 
  dplyr::mutate(Var1=factor(rn, levels=paste0(var_labels_df[12:41,]$x,"_num_sm"),labels=var_labels_df[12:41,]$V2))%>% 
  dplyr::mutate(rn=gsub("*_[1-9]_.*","",rn)) %>% 
  dplyr::select("Var1","rn",paste0("PA",1:attributes(loadings(modelo_4_factores))$dim[2])) 


colnames(modelo_cargas_fac2)<- c("Vars","cod",paste0(paste0("PA",1:attributes(loadings(modelo_4_factores))$dim[2]),"\nR$^{2}$=",round(modelo_4_factores$R2,2)))

modelo_cargas_fac2 %>% 
  knitr::kable(format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Tabla. Cargas factoriales, Modelo de 4 factores Total de Preguntas"),
               #col.names = c("Prueba","Estadistico","Valor p","Normalidad"),
               escape=F,
align =c('l',rep('c', 101)))%>%
    kableExtra::add_footnote(c("Nota. Se omiten cargas factoriales menores a .3"), notation = "none")%>%
  kableExtra::kable_classic() %>% 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12)
(#tab:fa_sm_2)Tabla. Cargas factoriales, Modelo de 4 factores Total de Preguntas
Vars cod PA1 R\(^{2}\)=0.97 PA2 R\(^{2}\)=0.97 PA3 R\(^{2}\)=0.97 PA4 R\(^{2}\)=0.92
Entiendo cómo mi trabajo contribuye a la consecución de los objetivos de esta empresa comp_sos 0.59
Recomendaría esta empresa como un buen lugar para trabajar comp_sos 0.55
Estoy dispuesto a realizar un esfuerzo mayor del que cabría esperar normalmente para contribuir al éxito de esta empresa comp_sos 0.71
Dispongo de las herramientas y los recursos necesarios para lograr la excelencia en el rendimiento comp_sos
0.69
Sé lo que se espera de mí en mi trabajo comp_sos 0.6
Mi trabajo me ofrece la oportunidad de enfrentarme a nuevos desafíos comp_sos 0.78
Las personas con las que trabajo por lo general se llevan bien entre sí comp_sos
0.36
Mi trabajo me aporta una sensación de realización personal comp_sos 0.89
Puedo mantener el nivel de energía que necesito durante toda la jornada laboral comp_sos 0.46
Creo que permanecer en esta empresa es lo mejor para mí desde el punto de vista profesional y personal dllo_prof 0.93
La formación que he recibido me ha preparado adecuadamente para el trabajo que hago dllo_prof
0.71
Dispongo de suficientes oportunidades de recibir formación para mejorar mis habilidades en mi trabajo actual dllo_prof
0.68
Soy optimista respecto al futuro de esta empresa lid 0.69
Tengo confianza en las decisiones que toma el equipo directivo de esta empresa lid 0.36
0.39
Mi responsable directo se preocupa realmente por mí como empleado ent_trab
0.89
Me siento cómodo con los valores de esta empresa ent_trab 0.38
0.41
Confío en que nuestros líderes respondan eficazmente a los desafíos de negocio derivados del coronavirus. covid
0.74
Siento que la compañía me está protegiendo durante este tiempo. covid
0.85
Confío en nuestros líderes para proteger la salud y el bienestar de los empleados en este momento. covid
0.94
Esta organización está haciendo un excelente trabajo manteniendo a los empleados informados sobre los asuntos importantes que nos afectan durante este tiempo. covid
0.73
Considero que seguiré trabajando en la empresa en los próximos dos años intencion 0.86
En esta empresa se hacen esfuerzos suficientes por conocer las opiniones e ideas de los empleados com
0.4
Tengo acceso a la información necesaria para hacer bien mi trabajo com
0.62
Recibo feedback sobre mi rendimiento con regularidad. ges_des
0.63
Según mi experiencia, en esta empresa se reconoce la excelencia en el rendimiento. ges_des
0.44
El programa de beneficios sociales de esta organización satisface mis necesidades comp_ben
0.37
Creo que mi remuneración es competitiva si la comparamos con la de personas que desempeñan un trabajo similar en otras empresas comp_ben 0.36
Mi responsable directo hace una buena labor fomentando el trabajo en equipo superv
0.92
Mi responsable directo me reconoce el trabajo bien hecho superv
0.95
Mi responsable directo fomenta el desarrollo de los empleados superv
0.93
Nota. Se omiten cargas factoriales menores a .3
Show code
#Para hacer esta evaluación desde el punto de vista estadístico se recurre a la significancia de las ponderaciones, así: valores menores a |0,3| se consideran no significativos; entre |0,3| y |0,5|, de aporte mínimo; entre |0,5| y |0,7|, de aporte significativo, y valores mayores a |0,7| son consideradas relevantes y, generalmente, son el objetivo del análisis. Sin embargo, es frecuente que en ocasiones valores mayores a |0,3| también sean considerados para los análisis (2,3,5).


En vista de lo obtenido en la tabla anterior, se puede colegir que la primera dimensión hace alusión a la identificación con la empresa, proyección en ella, involucramiento y en cierta medida, claridad de roles. Un hallazgo importante es que la percepción de contar con recursos necesarios para hacer el trabajo tiene mucha relación con la formación recibida y las oportunidades de recibirla (PA1). Esta subdimensión está algo contaminada por la tercera subdimensión en las preguntas que aluden a la confianza en directores y comodidad con valores de la empresa, que se explicará adelante. Adicionalmente, la formación se relaciona con el reconocimiento recibido y la información para hacer el trabajo (PA4). Un caso especial es la pregunta de si la empresa hace esfuerzos por conocer las opiniones e ideas de los empleados, ya que se relaciona fuertemente con la dimensión asociada a la identidad valórica. Sobre esta última (PA3), está integrada por la capacidad desiderativa, valórica y a su vez relacionada con el contexto COVID-19, con preguntas que aluden principalmente a la empresa en general. Por último, la segunda dimensión (PA2), a diferencia de la anterior, se enfoca en la relación con el supervisor inmediato, ya sea en términos de preocupación, entrega de feedback, trabajo en equipo, reconocimiento y orientación al desarrollo.


Show code
#invisible(fa.graph(modelo_6_factores))
library(DiagrammeR) 
gr1<-
DiagrammeR::grViz([2425 chars quoted with '"']
)

gr1


Análisis Factorial Confirmatorio (AFC)

1 factor

El AFC se caracteriza por permitir al investigador definir cuántos factores espera, qué factores están relacionados entre sí, y qué ítems están relacionados con cada factor (Kline 2013). El foco está puesto en los ítems y en qué medida se responden de manera similar. Decidimos comparar los índices de ajuste de múltiples especificaciones. El estimador utilizado para el análisis factorial es el “WLSMV” (Mínimos cuadrados ponderados diagonalmente), el cual es robusto a anormalidad y es especialmente recomendado para variables ordinales que violan los supuestos de anormalidad multivariada, especialmente en muestras mayores a 200 (Li 2016).


Show code
library(lavaan)  
library(semPlot)
library(semTools)
  # Latent variables
#dplyr::select(encuesta_rec, comp_sos_1:superv_3)

 #"comp_sos_1_num_sm"  "comp_sos_2_num_sm"  "comp_sos_3_num_sm"  "comp_sos_4_num_sm"  "comp_sos_5_num_sm"  "comp_sos_6_num_sm"  "comp_sos_7_num_sm"  "comp_sos_8_num_sm"  "comp_sos_9_num_sm" "dllo_prof_1_num_sm" "dllo_prof_2_num_sm" "dllo_prof_3_num_sm" "lid_1_num_sm"       "lid_2_num_sm"       "ent_trab_1_num_sm"  "ent_trab_2_num_sm"  "covid_1_num_sm"     "covid_2_num_sm"    "covid_3_num_sm"     "covid_4_num_sm"     "intencion_1_num_sm" "com_1_num_sm"       "com_2_num_sm"       "ges_des_1_num_sm"   "ges_des_2_num_sm"   "comp_ben_1_num_sm"  "comp_ben_2_num_sm" "superv_1_num_sm"    "superv_2_num_sm"    "superv_3_num_sm"   
  
tot_1f_inicial_form <- "
total =~  comp_sos_1_num_sm+  comp_sos_2_num_sm+  comp_sos_3_num_sm+  comp_sos_4_num_sm+ comp_sos_5_num_sm+  comp_sos_6_num_sm+ comp_sos_7_num_sm+ comp_sos_8_num_sm+  comp_sos_9_num_sm+ dllo_prof_1_num_sm+  dllo_prof_2_num_sm+ dllo_prof_3_num_sm+  lid_1_num_sm+ lid_2_num_sm+ ent_trab_1_num_sm+ ent_trab_2_num_sm+ covid_1_num_sm+ covid_2_num_sm+ covid_3_num_sm+ covid_4_num_sm+ intencion_1_num_sm+ com_1_num_sm+ com_2_num_sm+ ges_des_1_num_sm+ ges_des_2_num_sm+ comp_ben_1_num_sm+ comp_ben_2_num_sm+ superv_1_num_sm+ superv_2_num_sm+ superv_3_num_sm
"
tot_4f_inicial_form <- "
fa1 =~  comp_sos_1_num_sm+  comp_sos_2_num_sm+  comp_sos_3_num_sm+  comp_sos_5_num_sm+   comp_sos_6_num_sm+ comp_sos_8_num_sm+  comp_sos_9_num_sm+ lid_1_num_sm+ intencion_1_num_sm+ comp_ben_2_num_sm
fa2=~ comp_sos_7_num_sm+ ent_trab_1_num_sm+ ges_des_1_num_sm+ superv_1_num_sm+ superv_2_num_sm+ superv_3_num_sm
fa3=~ lid_2_num_sm+ ent_trab_2_num_sm+ covid_1_num_sm+ covid_2_num_sm+ covid_3_num_sm+ covid_4_num_sm+ com_1_num_sm+ comp_ben_1_num_sm
fa4=~ comp_sos_4_num_sm+ dllo_prof_1_num_sm+  dllo_prof_2_num_sm+ dllo_prof_3_num_sm+ com_2_num_sm + ges_des_2_num_sm
"
# ent_trab_2_num_sm+  se saca

tot_1f_inicial<- lavaan::cfa(tot_1f_inicial_form, data = meas_model_original[complete.cases(meas_model_original),], ordered=names(meas_model_original), estimator= "WLSMV", warn =T, std.lv=T)
tot_4f_inicial<- lavaan::cfa(tot_4f_inicial_form, data = meas_model_original[complete.cases(meas_model_original),], ordered=names(meas_model_original), estimator= "WLSMV", warn =T, std.lv=T)
# 
# sm_5f_sin_irr<- lavaan::cfa(sm_5f_sin_irr_form, data = dim_sm_p345_original[complete.cases(dim_sm_p345_original),], ordered=names(meas_model_original)[-4], estimator= "WLSMV", warn = T)

#ent_trab_2_num_sm  0.428 0.000 0.485 0.000
Show code
data.table::data.table(
  cbind(modelos= c("1 factor",
        #"5 factores", "6 factores", "1 factor, Salud Mental (sin 'Irritable')",
        "4 factores"),rbind(ajusteAFC(tot_1f_inicial), 
                             # ajusteAFC(tot_4f_inicial),
                             # ajusteAFC(sm_6f_inicial),
                             # ajusteAFC(sm_1f_sin_irr),
                             ajusteAFC(tot_4f_inicial)
                    )),keep.rownames = F) %>% 
  knitr::kable(.,format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Tabla. Comparativo Índices de Ajuste de Modelos Propuestos para el Total de Preguntas"),
               align =c('l',rep('c', 101)),
             col.names = c("Modelos","Código", "gl","WLS $X^2$","CMIN/df","aGFI","GFI", "RMSEA\n[IC 90%]","CFit","CFI","NNFI"), escape=T) %>%
  kableExtra::kable_classic() %>% 
      #kableExtra::row_spec(1, bold= T, color= "black", background= "white")%>%
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12)
(#tab:afc_sm_2)Tabla. Comparativo Índices de Ajuste de Modelos Propuestos para el Total de Preguntas
Modelos Código gl WLS \(X^2\) CMIN/df aGFI GFI RMSEA [IC 90%] CFit CFI NNFI
1 factor tot_1f_inicial 405 3731.859 9.214 0.981 0.986 0.118[0.115-0.122] 0.000 0.987 0.986
4 factores tot_4f_inicial 399 1078.522 2.703 0.995 0.996 0.054[0.050-0.058] 0.046 0.997 0.997


A partir de lo observado en la Tabla anterior, el ajuste mejora cuando se asumen 4 factores respecto a asumir que todas las preguntas responden a un solo único factor. De todas formas, el modelo que asume 10 factores no converge, posiblemente porque el modelo hipotetizado no se adapta a los datos y hay subdimeniones con menos de 3 ítems. Atendiendo a la inquietud presentada en el análisis exploratorio, se presentan los índices de modificación al modelo de un factor, sin haber eliminado ítems. Se examinaron aquellos parámetros de modificación que presentaran un índice de modifcación (MI) mayor a 5 y cambios esperados del parámetro (Expected Parameter Change o SEPC) mayores a 0,2 (Whittaker 2012).


Show code
tot_1f_inicial_mi<-
  subset(lavaan::modindices(tot_1f_inicial)[order(lavaan::modindices(tot_1f_inicial)$mi, decreasing=TRUE), ], mi > 5 & abs(sepc.all)>0.2)%>%
  data.frame()%>%
  dplyr::mutate(lhs=paste0(lhs,op,rhs))%>%
  dplyr::mutate(mi=sprintf("%04.2f",mi))%>%
  dplyr::mutate(sepc.all=sprintf("%04.2f",sepc.all))%>%
  dplyr::select(lhs,mi,sepc.all) %>% 
  dplyr::mutate(cnt=stringr::str_count(lhs, gsub("*_[1-9]_.*","",lhs))) %>% 
  dplyr::filter(cnt<2) %>% 
  dplyr::select(-cnt)
  
  knitr::kable(tot_1f_inicial_mi,format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Tabla. Índices de Modificación, Modelo de Un Factor del Total de Preguntas"),
               align =c('l',rep('c', 101)),
               col.names = c("Relación entre variables","Índice de Modificación", "Cambio esperado del parámetro Estandarizado (SEPC)"))%>%
    kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) %>%
    kableExtra::row_spec(which(abs(as.numeric(tot_1f_inicial_mi$sepc.all))>1), bold= T)%>%
  kableExtra::add_footnote(c("Nota. SEPC> +-1 en negrita","=~ : efecto de una variable observada en una variable latente","~~: covarianza entre los errores de dos variables observadas"),
                            notation = "none")%>%
  kableExtra::kable_classic() %>% 
  kableExtra::scroll_box(width = "100%", height = "375px")
(#tab:sm_afc_mi)Tabla. Índices de Modificación, Modelo de Un Factor del Total de Preguntas
Relación entre variables Índice de Modificación Cambio esperado del parámetro Estandarizado (SEPC)
ent_trab_1_num_sm~~superv_1_num_sm 270.05 0.92
dllo_prof_1_num_sm~~intencion_1_num_sm 62.90 0.58
covid_3_num_sm~~superv_3_num_sm 58.56 -1.66
ent_trab_1_num_sm~~superv_2_num_sm 53.99 0.57
covid_3_num_sm~~superv_2_num_sm 45.88 -1.31
comp_sos_8_num_sm~~dllo_prof_1_num_sm 40.52 0.47
covid_2_num_sm~~superv_3_num_sm 39.81 -1.26
covid_2_num_sm~~superv_2_num_sm 36.72 -1.12
covid_4_num_sm~~superv_3_num_sm 36.46 -1.10
ent_trab_1_num_sm~~superv_3_num_sm 36.34 0.51
covid_2_num_sm~~superv_1_num_sm 35.61 -0.97
covid_3_num_sm~~superv_1_num_sm 35.59 -1.01
covid_1_num_sm~~superv_3_num_sm 35.07 -1.10
comp_sos_8_num_sm~~superv_1_num_sm 33.95 -0.90
dllo_prof_1_num_sm~~superv_2_num_sm 31.97 -1.04
comp_sos_8_num_sm~~superv_3_num_sm 31.82 -0.95
covid_1_num_sm~~superv_2_num_sm 31.77 -0.96
comp_sos_8_num_sm~~superv_2_num_sm 31.56 -0.91
dllo_prof_1_num_sm~~superv_1_num_sm 31.53 -0.97
lid_2_num_sm~~superv_3_num_sm 31.37 -0.91
comp_sos_2_num_sm~~superv_3_num_sm 30.65 -1.01
covid_4_num_sm~~superv_2_num_sm 27.58 -0.88
dllo_prof_1_num_sm~~superv_3_num_sm 27.38 -1.03
lid_2_num_sm~~superv_2_num_sm 26.91 -0.78
comp_sos_8_num_sm~~ent_trab_1_num_sm 25.89 -0.71
dllo_prof_3_num_sm~~covid_3_num_sm 25.63 -0.76
comp_sos_2_num_sm~~superv_2_num_sm 24.93 -0.82
covid_4_num_sm~~superv_1_num_sm 24.33 -0.73
lid_1_num_sm~~superv_3_num_sm 23.84 -1.06
intencion_1_num_sm~~superv_2_num_sm 23.65 -0.86
comp_sos_6_num_sm~~superv_1_num_sm 22.91 -0.67
lid_1_num_sm~~superv_2_num_sm 21.93 -0.94
ent_trab_2_num_sm~~superv_3_num_sm 21.83 -0.82
com_1_num_sm~~superv_3_num_sm 20.91 -0.67
com_1_num_sm~~superv_2_num_sm 20.63 -0.65
dllo_prof_1_num_sm~~covid_3_num_sm 20.54 -0.71
comp_sos_8_num_sm~~covid_3_num_sm 20.07 -0.70
covid_1_num_sm~~superv_1_num_sm 20.06 -0.64
dllo_prof_1_num_sm~~ent_trab_1_num_sm 19.93 -0.69
comp_ben_2_num_sm~~superv_2_num_sm 19.73 -0.59
comp_sos_4_num_sm~~superv_2_num_sm 19.65 -0.63
dllo_prof_2_num_sm~~com_2_num_sm 19.55 0.34
comp_sos_3_num_sm~~superv_3_num_sm 19.54 -0.80
com_2_num_sm~~superv_3_num_sm 19.47 -0.66
comp_sos_6_num_sm~~covid_3_num_sm 19.31 -0.70
comp_ben_1_num_sm~~superv_2_num_sm 19.30 -0.58
lid_1_num_sm~~superv_1_num_sm 19.28 -0.83
ges_des_1_num_sm~~superv_2_num_sm 18.99 0.38
ent_trab_1_num_sm~~covid_3_num_sm 18.94 -0.66
com_2_num_sm~~superv_2_num_sm 18.47 -0.61
ent_trab_1_num_sm~~covid_4_num_sm 18.46 -0.63
comp_sos_9_num_sm~~superv_2_num_sm 18.22 -0.57
intencion_1_num_sm~~superv_3_num_sm 18.17 -0.75
lid_2_num_sm~~superv_1_num_sm 18.13 -0.60
comp_sos_4_num_sm~~com_2_num_sm 17.93 0.32
comp_sos_6_num_sm~~superv_2_num_sm 17.89 -0.63
com_1_num_sm~~superv_1_num_sm 17.73 -0.50
comp_sos_4_num_sm~~superv_3_num_sm 17.63 -0.61
comp_sos_9_num_sm~~superv_3_num_sm 17.47 -0.61
ent_trab_1_num_sm~~ges_des_1_num_sm 17.40 0.33
comp_sos_3_num_sm~~superv_2_num_sm 17.34 -0.67
comp_sos_6_num_sm~~ent_trab_1_num_sm 17.34 -0.57
comp_sos_1_num_sm~~superv_3_num_sm 16.77 -0.72
lid_1_num_sm~~ent_trab_1_num_sm 16.63 -0.71
lid_2_num_sm~~ent_trab_1_num_sm 16.36 -0.50
comp_sos_2_num_sm~~superv_1_num_sm 16.08 -0.59
intencion_1_num_sm~~superv_1_num_sm 16.05 -0.59
comp_sos_4_num_sm~~dllo_prof_2_num_sm 16.04 0.28
dllo_prof_3_num_sm~~covid_2_num_sm 16.03 -0.54
ent_trab_1_num_sm~~covid_2_num_sm 15.91 -0.58
covid_3_num_sm~~intencion_1_num_sm 15.84 -0.65
comp_sos_6_num_sm~~superv_3_num_sm 15.76 -0.61
ent_trab_2_num_sm~~superv_1_num_sm 15.75 -0.56
comp_sos_4_num_sm~~dllo_prof_3_num_sm 15.27 0.28
lid_1_num_sm~~intencion_1_num_sm 14.79 0.36
ges_des_1_num_sm~~superv_3_num_sm 14.78 0.37
comp_ben_1_num_sm~~superv_3_num_sm 14.69 -0.54
dllo_prof_2_num_sm~~superv_2_num_sm 14.67 -0.53
comp_sos_8_num_sm~~covid_2_num_sm 14.62 -0.55
comp_sos_4_num_sm~~ent_trab_1_num_sm 14.58 -0.44
lid_1_num_sm~~covid_3_num_sm 14.36 -0.68
ent_trab_2_num_sm~~superv_2_num_sm 14.29 -0.58
comp_sos_6_num_sm~~covid_2_num_sm 13.34 -0.55
ent_trab_1_num_sm~~covid_1_num_sm 13.25 -0.49
comp_ben_1_num_sm~~superv_1_num_sm 13.11 -0.42
dllo_prof_3_num_sm~~ges_des_2_num_sm 13.03 0.28
covid_3_num_sm~~ges_des_1_num_sm 12.94 -0.49
dllo_prof_3_num_sm~~superv_2_num_sm 12.62 -0.48
covid_3_num_sm~~ges_des_2_num_sm 12.56 -0.53
comp_ben_2_num_sm~~superv_3_num_sm 12.24 -0.48
com_2_num_sm~~superv_1_num_sm 12.18 -0.41
ent_trab_1_num_sm~~com_1_num_sm 12.09 -0.39
comp_sos_2_num_sm~~ent_trab_1_num_sm 11.77 -0.47
comp_sos_3_num_sm~~superv_1_num_sm 11.73 -0.49
comp_sos_1_num_sm~~superv_1_num_sm 11.69 -0.48
ent_trab_1_num_sm~~comp_ben_1_num_sm 11.40 -0.38
comp_sos_4_num_sm~~superv_1_num_sm 11.33 -0.39
comp_sos_2_num_sm~~lid_2_num_sm 11.18 0.29
comp_sos_1_num_sm~~superv_2_num_sm 10.88 -0.53
covid_3_num_sm~~com_2_num_sm 10.81 -0.47
dllo_prof_2_num_sm~~covid_3_num_sm 10.67 -0.45
dllo_prof_2_num_sm~~superv_3_num_sm 10.63 -0.48
dllo_prof_1_num_sm~~lid_1_num_sm 10.57 0.34
dllo_prof_2_num_sm~~covid_2_num_sm 10.53 -0.42
lid_2_num_sm~~com_1_num_sm 10.33 0.27
ent_trab_1_num_sm~~intencion_1_num_sm 10.31 -0.46
ges_des_1_num_sm~~superv_1_num_sm 10.24 0.26
ent_trab_1_num_sm~~ges_des_2_num_sm 10.15 -0.38
comp_sos_9_num_sm~~superv_1_num_sm 9.90 -0.35
covid_2_num_sm~~intencion_1_num_sm 9.85 -0.45
covid_4_num_sm~~intencion_1_num_sm 9.52 -0.42
ent_trab_1_num_sm~~com_2_num_sm 9.48 -0.37
dllo_prof_3_num_sm~~com_2_num_sm 9.33 0.24
comp_sos_5_num_sm~~covid_3_num_sm 9.30 -0.47
comp_sos_3_num_sm~~ent_trab_1_num_sm 8.87 -0.39
comp_sos_9_num_sm~~ent_trab_1_num_sm 8.84 -0.32
lid_2_num_sm~~ent_trab_2_num_sm 8.57 0.27
covid_2_num_sm~~ges_des_2_num_sm 8.39 -0.38
dllo_prof_2_num_sm~~ent_trab_1_num_sm 8.36 -0.33
dllo_prof_2_num_sm~~superv_1_num_sm 8.35 -0.35
dllo_prof_3_num_sm~~covid_4_num_sm 8.17 -0.35
comp_ben_2_num_sm~~superv_1_num_sm 8.13 -0.29
ges_des_2_num_sm~~superv_2_num_sm 8.08 -0.38
comp_sos_3_num_sm~~lid_1_num_sm 7.67 0.29
lid_1_num_sm~~covid_2_num_sm 7.66 -0.47
dllo_prof_1_num_sm~~covid_2_num_sm 7.56 -0.38
ent_trab_1_num_sm~~comp_ben_2_num_sm 7.54 -0.28
comp_sos_8_num_sm~~covid_1_num_sm 7.45 -0.35
covid_2_num_sm~~ges_des_1_num_sm 7.36 -0.33
comp_sos_7_num_sm~~superv_1_num_sm 7.22 0.23
ges_des_2_num_sm~~superv_3_num_sm 7.09 -0.36
comp_sos_4_num_sm~~covid_3_num_sm 7.00 -0.34
comp_sos_6_num_sm~~dllo_prof_1_num_sm 6.97 0.24
ges_des_2_num_sm~~superv_1_num_sm 6.95 -0.32
comp_sos_5_num_sm~~covid_2_num_sm 6.93 -0.37
dllo_prof_3_num_sm~~covid_1_num_sm 6.88 -0.31
dllo_prof_3_num_sm~~ent_trab_1_num_sm 6.62 -0.30
comp_sos_8_num_sm~~covid_4_num_sm 6.57 -0.33
dllo_prof_1_num_sm~~covid_1_num_sm 6.27 -0.32
comp_sos_4_num_sm~~covid_2_num_sm 6.11 -0.29
dllo_prof_3_num_sm~~superv_1_num_sm 6.02 -0.28
comp_sos_2_num_sm~~ent_trab_2_num_sm 5.92 0.22
comp_sos_5_num_sm~~superv_2_num_sm 5.92 -0.33
dllo_prof_3_num_sm~~superv_3_num_sm 5.68 -0.31
comp_sos_5_num_sm~~covid_1_num_sm 5.67 -0.31
comp_sos_8_num_sm~~ges_des_1_num_sm 5.52 -0.25
comp_sos_7_num_sm~~dllo_prof_1_num_sm 5.34 -0.26
lid_1_num_sm~~covid_1_num_sm 5.31 -0.35
comp_sos_1_num_sm~~intencion_1_num_sm 5.31 0.22
covid_2_num_sm~~com_2_num_sm 5.10 -0.29
comp_sos_2_num_sm~~ges_des_1_num_sm 5.08 -0.25
Nota. SEPC> +-1 en negrita
=~ : efecto de una variable observada en una variable latente
~~: covarianza entre los errores de dos variables observadas


Uno de los ítems con mayores índices de modificación y que aparece de manera más recurrente fue el ent_trab_1 (Mi responsable directo se preocupa realmente por mí como empleado) que muestra una importante covarianza con el ítem superv_1 (Mi responsable directo hace una buena labor fomentando el trabajo en equipo). Otra relación importante es el de dllo_prof_1 (Creo que permanecer en esta empresa es lo mejor para mí desde el punto de vista profesional y personal) que muestra una importante covarianza con el ítem intencion_1 (Considero que seguiré trabajando en la empresa en los próximos dos años). Una tercera relación importante es el de covid_3 (Confío en nuestros líderes para proteger la salud y el bienestar de los empleados en este momento.) que muestra una importante covarianza con el ítem superv_3 (Mi responsable directo fomenta el desarrollo de los empleados). Una cuarta relación importante es el de ent_trab_1 (Mi responsable directo se preocupa realmente por mí como empleado) que muestra una importante covarianza con el ítem superv_2 (Mi responsable directo me reconoce el trabajo bien hecho). Una quinta relación importante es el de covid_3 (Confío en nuestros líderes para proteger la salud y el bienestar de los empleados en este momento.) que muestra una importante covarianza con el ítem superv_2 (Mi responsable directo me reconoce el trabajo bien hecho).


Show code
"to provide minimum coverage of the construct's theoretical domain" (Hair et al., 2010, pg.676).

An item selection procedure to maximise scale reliability and validity
J. Raubenheimer
SA Journal of Industrial Psychology | Vol 30, No 4 | a168 | DOI: https://doi.org/10.4102/sajip.v30i4.168 | © 2004 J. Raubenheimer | This work is licensed under CC Attribution 4.0
Submitted: 26 October 2004 | Published: 26 October 2004
Bollen (1989) fully and thoroughly discusses the issues of identification of CFA models in chapter 7. See p. 244 specifically regarding three- and two-indicator rules.
It is recommended that each subscale include at least three items in order to capture the true central
of each dimension
Show code
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#Para ver el número de parámetros
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_

if(no_mostrar==1){
for (i in 2:100){
  ano<-i
  try(semPlot::semPaths(tot_1f_inicial, 
                  residuals=T, 
                  what="std", 
                  label.cex=1.5, 
                  edge.label.cex=1,
                  fade=FALSE,
                  thresholds = F,
                  edge.label.position=rep(.5,ano),
                  filetype="pdf",
                  filename=paste0("Número de parámetros ",ano),
                  intercepts=F)
    )
  }
}

#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
semPlot::semPaths(tot_1f_inicial, 
                  residuals=T, 
                  what="std", 
                  label.cex=1, 
                  edge.label.cex=1,
                  fade=FALSE,
                  thresholds = F,
                  edge.label.position=c(rep(c(0.45,0.55,0.65),20),rep(0.5,28),rep(0.5,3)), #11  it, #17 #14 parámetros para las cargas
                  nodeLabels=c(names(dplyr::select(encuesta_rec,comp_sos_1:superv_3)), "total"),
                  intercepts=F, 
                  curveAdjacent = TRUE,
                  title=F, 
                  layout="tree3",
                  sizeMan=5, 
                  gui = T, 
                  allVars = FALSE,
                  cut=1.1,
                  sizeLat=4, 
                  edge.color="black",
                  curvePivot=T,
                  borders=FALSE, 
                  edge.width = 0.5, 
                  node.width =1, 
                  node.height= 1,
                  label.scale=T,
                  curve = 1,
                  mar = c(5.8, 0.8, 7.8, 0.8))
Figura 5. Cargas factoriales estandarizadas y comunalidades (solución de 1 factor)

(#fig:fig_cfa_sm)Figura 5. Cargas factoriales estandarizadas y comunalidades (solución de 1 factor)

Show code
#https://www.redalyc.org/journal/212/21254609002/html/


Se puede apreciar cierto sesgo de varianza del método común, es decir, que ciertos sesgos intervengan en que no haya variación en las respuestas dada la misma forma de administración de la encuesta y los sesgos que operan al completarla, más que por la relación o no-relación de los constructos medidos. De los pocos ítems que covarían bajo los umbrales (y por tanto correlacionan menos con el resto de los ítems, lo que equivale a decir que tales ítemes no suben en puntaje de acuerdo cuando el otro sube, no bajan cuando el otro baja, no suben cuando el otro baja o viceversa) se encuentra el ítem comp_sos_7 (Las personas con las que trabajo por lo general se llevan bien entre sí) y en menor medida comp_ben_2 (Creo que mi remuneración es competitiva si la comparamos con la de personas que desempeñan un trabajo similar en otras empresas).

4 factores


Show code
#Cargas factoriales.
afc_lambda_std_sm2<-
data.table::data.table(lavaan::lavInspect(tot_4f_inicial, what = "std", add.labels = TRUE)$`lambda`,keep.rownames = T) %>% 
  dplyr::mutate(V2=factor(rn, levels=paste0(var_labels_df[12:41,]$x,"_num_sm"),labels=var_labels_df[12:41,]$V2))%>% 
  dplyr::mutate(V2=as.character(V2)) %>% 
  #dplyr::left_join(cols_labels, by=c("rn"="V1")) %>% 
  dplyr::select(V2,everything()) %>% 
  dplyr::mutate(across(where(is.numeric), ~ sprintf("%04.2f",.x))) %>% # round(, 2)
  dplyr::mutate(across(where(is.numeric), ~ ifelse(.x==0,NA,.x))) 
for (i in 1:nrow(afc_lambda_std_sm2)){
afc_lambda_std_sm2$V2[i]<-stringr::str_wrap(afc_lambda_std_sm2$V2[i], width = 40, indent = 0, exdent = 0)
}

  # dplyr::mutate(Var1=factor(rn, levels=paste0(var_labels_df[12:41,]$x,"_num_sm"),labels=var_labels_df[12:41,]$V2))%>% 
var_labels_df[12:41,]$x[which(is.na(match(paste0(var_labels_df[12:41,]$x,"_num_sm"),afc_lambda_std_sm2$rn)))]
character(0)
Show code
#R cuadrado var latentes
afc_psi_std_sm2<-
cbind.data.frame(V2=c("Identificación, proyección e involucramiento", "Supervisor inmediato", "Capacidad desiderativa y valórica de la empresa", "Formación e Información"),
data.table::data.table(lavaan::lavInspect(tot_4f_inicial, what = "std", add.labels = TRUE)$psi,keep.rownames = T)) %>% 
  dplyr::mutate(across(where(is.numeric), ~ sprintf("%04.2f",.x))) %>% 
  dplyr::mutate(across(where(is.numeric), ~ ifelse(.x==1,NA,.x))) 

rbind.data.frame(afc_lambda_std_sm2,
                 afc_psi_std_sm2) %>% 
  knitr::kable(format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Tabla. Cargas Factoriales y Covarianzas Variables Latentes"),
               align =c('l',rep('c', 101)),
               col.names = c("Ítem","Código", 
                             "Identificación, proyección e involucramiento", "Supervisor inmediato", "Capacidad desiderativa y valórica de la empresa", "Formación e Información"))%>%
    kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) %>%
  kableExtra::pack_rows("Variables manifiestas", 1, 29) %>%
  kableExtra::pack_rows("Variables latentes", 30, 33) %>%
  kableExtra::add_footnote(c("Nota. "),
                            notation = "none")%>%
  kableExtra::kable_classic() %>% 
  kableExtra::scroll_box(width = "100%", height = "375px")
(#tab:afc_sm_3)Tabla. Cargas Factoriales y Covarianzas Variables Latentes
Ítem Código Identificación, proyección e involucramiento Supervisor inmediato Capacidad desiderativa y valórica de la empresa Formación e Información
Variables manifiestas
Entiendo cómo mi trabajo contribuye a la consecución de los objetivos de esta empresa comp_sos_1_num_sm 0.73 0.00 0.00 0.00
Recomendaría esta empresa como un buen lugar para trabajar comp_sos_2_num_sm 0.88 0.00 0.00 0.00
Estoy dispuesto a realizar un esfuerzo mayor del que cabría esperar normalmente para contribuir al éxito de esta empresa comp_sos_3_num_sm 0.80 0.00 0.00 0.00
Sé lo que se espera de mí en mi trabajo comp_sos_5_num_sm 0.76 0.00 0.00 0.00
Mi trabajo me ofrece la oportunidad de enfrentarme a nuevos desafíos comp_sos_6_num_sm 0.84 0.00 0.00 0.00
Mi trabajo me aporta una sensación de realización personal comp_sos_8_num_sm 0.88 0.00 0.00 0.00
Puedo mantener el nivel de energía que necesito durante toda la jornada laboral comp_sos_9_num_sm 0.72 0.00 0.00 0.00
Soy optimista respecto al futuro de esta empresa lid_1_num_sm 0.92 0.00 0.00 0.00
Considero que seguiré trabajando en la empresa en los próximos dos años intencion_1_num_sm 0.85 0.00 0.00 0.00
Creo que mi remuneración es competitiva si la comparamos con la de personas que desempeñan un trabajo similar en otras empresas comp_ben_2_num_sm 0.70 0.00 0.00 0.00
Las personas con las que trabajo por lo general se llevan bien entre sí comp_sos_7_num_sm 0.00 0.70 0.00 0.00
Mi responsable directo se preocupa realmente por mí como empleado ent_trab_1_num_sm 0.00 0.92 0.00 0.00
Recibo feedback sobre mi rendimiento con regularidad. ges_des_1_num_sm 0.00 0.86 0.00 0.00
Mi responsable directo hace una buena labor fomentando el trabajo en equipo superv_1_num_sm 0.00 0.93 0.00 0.00
Mi responsable directo me reconoce el trabajo bien hecho superv_2_num_sm 0.00 0.95 0.00 0.00
Mi responsable directo fomenta el desarrollo de los empleados superv_3_num_sm 0.00 0.97 0.00 0.00
Tengo confianza en las decisiones que toma el equipo directivo de esta empresa lid_2_num_sm 0.00 0.00 0.91 0.00
Me siento cómodo con los valores de esta empresa ent_trab_2_num_sm 0.00 0.00 0.91 0.00
Confío en que nuestros líderes respondan eficazmente a los desafíos de negocio derivados del coronavirus. covid_1_num_sm 0.00 0.00 0.90 0.00
Siento que la compañía me está protegiendo durante este tiempo. covid_2_num_sm 0.00 0.00 0.91 0.00
Confío en nuestros líderes para proteger la salud y el bienestar de los empleados en este momento. covid_3_num_sm 0.00 0.00 0.93 0.00
Esta organización está haciendo un excelente trabajo manteniendo a los empleados informados sobre los asuntos importantes que nos afectan durante este tiempo. covid_4_num_sm 0.00 0.00 0.91 0.00
En esta empresa se hacen esfuerzos suficientes por conocer las opiniones e ideas de los empleados com_1_num_sm 0.00 0.00 0.87 0.00
El programa de beneficios sociales de esta organización satisface mis necesidades comp_ben_1_num_sm 0.00 0.00 0.79 0.00
Dispongo de las herramientas y los recursos necesarios para lograr la excelencia en el rendimiento comp_sos_4_num_sm 0.00 0.00 0.00 0.75
Creo que permanecer en esta empresa es lo mejor para mí desde el punto de vista profesional y personal dllo_prof_1_num_sm 0.00 0.00 0.00 0.92
La formación que he recibido me ha preparado adecuadamente para el trabajo que hago dllo_prof_2_num_sm 0.00 0.00 0.00 0.84
Dispongo de suficientes oportunidades de recibir formación para mejorar mis habilidades en mi trabajo actual dllo_prof_3_num_sm 0.00 0.00 0.00 0.86
Tengo acceso a la información necesaria para hacer bien mi trabajo com_2_num_sm 0.00 0.00 0.00 0.88
Variables latentes
Según mi experiencia, en esta empresa se reconoce la excelencia en el rendimiento. ges_des_2_num_sm 0.00 0.00 0.00 0.88
Identificación, proyección e involucramiento fa1 1.00 0.72 0.90 0.96
Supervisor inmediato fa2 0.72 1.00 0.73 0.78
Capacidad desiderativa y valórica de la empresa fa3 0.90 0.73 1.00 0.89
Formación e Información fa4 0.96 0.78 0.89 1.00
Nota.
Show code
#A factor with 2 variables is only considered reliable when the variables are highly correlated with each another (r > .70) but fairly uncorrelated with other variables. Yong, A. G., & Pearce, S. (2013, p. 80).


Show code
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#Para ver el número de parámetros
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_

if(no_mostrar==1){
for (i in 101:300){
  ano<-i
  try(semPlot::semPaths(tot_4f_inicial, 
                  residuals=T, 
                  what="std", 
                  label.cex=1.5, 
                  edge.label.cex=1,
                  fade=FALSE,
                  thresholds = F,
                  edge.label.position=rep(.5,ano),
                  filetype="pdf",
                  filename=paste0("Número de parámetros ",ano),
                  intercepts=F)
    )
  }
}
#"Identificación, proyección e involucramiento", "Supervisor inmediato", "Capacidad desiderativa y valórica de la empresa", "Formación e Información"
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
semPlot::semPaths(tot_4f_inicial, 
                  residuals=T, 
                  what="std", 
                  label.cex=.5, #103
                  edge.label.cex=.9,
                  fade=FALSE,
                  thresholds = F,
                  edge.label.position=c(rep(c(0.45,0.55,0.65),10),rep(0.5,76)), #29 it. y de ahi los residuos
                  nodeLabels=c(gsub("*_num_sm","",afc_lambda_std_sm2$rn), "id_proy_inv", "superv","valor_empr","form_inf"),
                  intercepts=F, 
                  curveAdjacent = TRUE,
                  title=F, 
                  layout="tree3",
                  sizeMan=3, 
                  gui = T, 
                  allVars = FALSE,
                  cut=1,
                  sizeLat=4, 
                  label.scale=F,
                  edge.color="black",
                  curvePivot=T,
                  borders=FALSE, 
                  edge.width = 0.5, 
                  node.width =1, 
                  node.height= 1,
                  label.scale=T,
                  curve = 1,
                  mar = c(5.8, 0.8, 7.8, 0.8))
Figura 5. Cargas factoriales estandarizadas y comunalidades (solución de 4 factores)

(#fig:fig_cfa_sm2)Figura 5. Cargas factoriales estandarizadas y comunalidades (solución de 4 factores)

Show code
#https://www.redalyc.org/journal/212/21254609002/html/


Considerando que existen factores en los que sólo se identifican 2 ítems y las altas covarianzas entre variables latentes, cabe discutir si existe un verdadero poder discriminante que permita identificar variables latentes a partir de sólo 2 ítems por dimensión (Yong and Pearce 2013). Por lo mismo, se utilizó el criterio HTMT (razón heterorazgo-monorrazgo) de las correlaciones, para explorar la validez discriminante de cada variable latente (Henseler, Ringle, and Sarstedt 2015).


Show code
# https://rdrr.io/cran/semTools/man/htmt.html
semTools::htmt(tot_4f_inicial_form,meas_model_original[complete.cases(meas_model_original),], sample.cov = NULL, missing = 'listwise', ordered = names(meas_model_original[complete.cases(meas_model_original),]), absolute = TRUE)%>% 
  as.data.table(keep.rownames = T) %>% 
  dplyr::mutate(across(where(is.numeric), ~ round(.x, 2))) %>% 
  knitr::kable(format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Tabla. Validez Discriminante"),
               align =c('l',rep('c', 101)),
               col.names = c("Var. Latentes","Identificación, proyección e involucramiento (fa1)", "Supervisor inmediato (fa2)", "Capacidad desiderativa y valórica de la empresa (fa3)", "Formación e Información (fa4)"))%>%
    kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) %>%
  kableExtra::add_footnote(c("Nota. "),
                            notation = "none")%>%
  kableExtra::kable_classic() %>% 
  kableExtra::scroll_box(width = "100%", height = "375px")
(#tab:afc_htmt)Tabla. Validez Discriminante
Var. Latentes Identificación, proyección e involucramiento (fa1) Supervisor inmediato (fa2) Capacidad desiderativa y valórica de la empresa (fa3) Formación e Información (fa4)
fa1 1.00 0.75 0.91 0.95
fa2 0.75 1.00 0.77 0.80
fa3 0.91 0.77 1.00 0.91
fa4 0.95 0.80 0.91 1.00
Nota.
Show code
#  Technically, the HTMT provides two advantages over the disattenuated construct score correlation: The HTMT does not require a factor analysis to obtain factor loadings, nor does it require the calculation of construct scores. This allows for determining the HTMT even if the raw data is not available, but the correlation matrix is. Furthermore, HTMT builds on the available measures and data and—contrary to the standard MTMM approach—does not require simultaneous surveying of the same theoretical concept with alternative measurement approaches. Therefore, this approach does not suffer from the standard MTMM approach’s well-known issues regarding data requirements and parallel measures (Schmitt 1978; Schmitt and Stults 1986).
# We suggest assessing the heterotrait-monotrait ratio (HTMT) of the correlations, which is the average of the heterotrait-heteromethod correlations (i.e., the correlations of indicators across constructs measuring different phenomena), relative to the average of the monotrait-heteromethod correlations 

#Use the HTMT criterion to assess discriminant validity! If the HTMT value is below 0.90, discriminant validity has been established between two reflective constructs. 


Por lo visto en la tabla anterior, la Identificación, proyección e involucramiento está fuertemente relacionada con la Capacidad desiderativa y valórica de la empresa. Por otra parte, la Formación e Información se encuentra fuertemente relacionada a la Identificación, proyección e involucramiento, y por otra parte, también fuertemente relacionada con la Capacidad desiderativa y valórica de la empresa.


Show code
#Calculate discriminant validity statistics based on a fitted lavaan object

#For the exploration, discriminant validity was examined with an R function, discriminantValidity, implemented in semToolspackage (Jorgensen et al., 2021). Discriminant validity was examined whether the two constructs, overall compliance and compliance with distancing measures, were distinguishable from each other. If a significant outcome results from 25χ2test, then discriminant validity between the tested constructs is supported, so the constructs are deemed to be distinct from each other (Jorgensen et al., 2021; Rönkkö & Cho, 2020). On the other hand, a non-significant outcome suggests that discriminant validity could not be supported, so it is impossible to distinguish the two constructs.The result of χ2test indicated that discriminant validity was supported, χ2(1) = 968.82, p< .001. Thus, although the two tested constructs, overall compliance and compliance with distancing measure, were significantly correlated with each other, they shall be treated as two distinguishable and independent constructs. It may suggest that the two items assess two unique and distinct constructs, so they could not be collapsed into one.

semTools::discriminantValidity(tot_4f_inicial, cutoff = 0.9, merge = F, level = 0.95) %>% 
  as.data.table(keep.rownames = T) %>% 
  dplyr::mutate(across(where(is.numeric), ~ sprintf("%04.2f",.x))) %>% 
  knitr::kable(format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Tabla. Validez Discriminante (2)"),
               align =c('l',rep('c', 101)),
               #col.names = c("Var. Latentes","Agotamiento y Estrés", "Sueño", "Estrés Postraumático", "Sint. Ansiosa", "Sint. Depresiva")
               escape=T)%>%
  kableExtra::kable_classic(bootstrap_options = c("striped", "hover"),font_size = 12) %>%
  kableExtra::add_footnote(c("Nota. "),
                           notation = "none")%>%
  kableExtra::scroll_box(width = "100%", height = "375px")
(#tab:dls_afc_disc_val_a)Tabla. Validez Discriminante (2)
rn lhs op rhs est ci.lower ci.upper Df AIC BIC Chisq Chisq diff Df diff Pr(>Chisq)
1 fa1 ~~ fa2 0.72 0.66 0.77 400.00 1564.16 53.50 1.00 0.00
2 fa1 ~~ fa3 0.90 0.87 0.92 400.00 1078.83 0.10 1.00 0.75
3 fa1 ~~ fa4 0.96 0.94 0.97 400.00 1078.52 0.00 1.00 1.00
4 fa2 ~~ fa3 0.73 0.69 0.78 400.00 1652.91 57.05 1.00 0.00
5 fa2 ~~ fa4 0.78 0.74 0.83 400.00 1257.86 28.42 1.00 0.00
6 fa3 ~~ fa4 0.89 0.87 0.91 400.00 1080.66 0.80 1.00 0.37
Nota.


Del análisis anterior, no es posible distinguir el factor 1 del 3, el 1 del 4 y el 3 del 4.


Show code
tot_4f_inicial_mi2<-
  subset(lavaan::modindices(tot_4f_inicial)[order(lavaan::modindices(tot_4f_inicial)$mi, decreasing=TRUE), ], mi > 5 & abs(sepc.all)>0.2)%>%
  data.frame()%>%
  dplyr::mutate(lhs=paste0(lhs,op,rhs))%>%
  dplyr::mutate(mi=sprintf("%04.2f",mi))%>%
  dplyr::mutate(sepc.all=sprintf("%04.2f",sepc.all))%>%
  dplyr::select(lhs,mi,sepc.all)
  
  knitr::kable(tot_4f_inicial_mi2,format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Tabla. Índices de Modificación, Modelo de Un Factor del Total de Preguntas"),
               align =c('l',rep('c', 101)),
               col.names = c("Relación entre variables","Índice de Modificación", "Cambio esperado del parámetro Estandarizado (SEPC)"))%>%
    kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) %>%
    #kableExtra::row_spec(which(abs(as.numeric(tot_1f_inicial_mi$sepc.all))>1), bold= T)%>%
  kableExtra::add_footnote(c("Nota. SEPC> +-1 en negrita","=~ : efecto de una variable observada en una variable latente","~~: covarianza entre los errores de dos variables observadas"),
                            notation = "none")%>%
  kableExtra::kable_classic() %>% 
  kableExtra::scroll_box(width = "100%", height = "375px")
(#tab:sm_afc_mi2)Tabla. Índices de Modificación, Modelo de Un Factor del Total de Preguntas
Relación entre variables Índice de Modificación Cambio esperado del parámetro Estandarizado (SEPC)
270 fa1=~dllo_prof_1_num_sm 133.33 1.97
341 fa4=~covid_3_num_sm 107.51 -0.69
265 fa1=~covid_3_num_sm 104.47 -0.73
725 covid_2_num_sm~~covid_3_num_sm 97.80 0.88
261 fa1=~lid_2_num_sm 64.28 0.60
255 fa1=~comp_sos_7_num_sm 53.68 0.29
337 fa4=~lid_2_num_sm 53.11 0.52
309 fa3=~comp_sos_7_num_sm 53.07 0.30
331 fa4=~comp_sos_7_num_sm 52.52 0.33
340 fa4=~covid_2_num_sm 52.38 -0.49
264 fa1=~covid_2_num_sm 51.39 -0.52
333 fa4=~ges_des_1_num_sm 51.15 0.27
774 dllo_prof_2_num_sm~~dllo_prof_3_num_sm 47.02 0.50
257 fa1=~ges_des_1_num_sm 46.82 0.22
343 fa4=~com_1_num_sm 45.53 0.48
583 comp_ben_2_num_sm~~comp_ben_1_num_sm 44.87 0.41
565 intencion_1_num_sm~~dllo_prof_1_num_sm 43.69 0.63
338 fa4=~ent_trab_2_num_sm 42.52 0.47
455 comp_sos_6_num_sm~~comp_sos_8_num_sm 42.48 0.50
262 fa1=~ent_trab_2_num_sm 40.71 0.47
311 fa3=~ges_des_1_num_sm 39.25 0.21
294 fa2=~dllo_prof_1_num_sm 38.52 -0.30
267 fa1=~com_1_num_sm 37.52 0.46
272 fa1=~dllo_prof_3_num_sm 34.91 -1.00
660 superv_2_num_sm~~superv_3_num_sm 30.23 0.91
268 fa1=~comp_ben_1_num_sm 28.26 0.44
715 covid_1_num_sm~~covid_3_num_sm 28.04 0.50
318 fa3=~dllo_prof_3_num_sm 26.97 -0.43
344 fa4=~comp_ben_1_num_sm 26.10 0.40
610 ent_trab_1_num_sm~~superv_1_num_sm 25.26 0.55
757 com_1_num_sm~~com_2_num_sm 24.08 0.49
499 comp_sos_8_num_sm~~dllo_prof_1_num_sm 23.97 0.49
271 fa1=~dllo_prof_2_num_sm 19.37 -0.80
643 ges_des_1_num_sm~~ges_des_2_num_sm 18.36 0.50
641 ges_des_1_num_sm~~dllo_prof_3_num_sm 15.76 0.44
773 dllo_prof_1_num_sm~~ges_des_2_num_sm 15.36 -0.61
535 lid_1_num_sm~~lid_2_num_sm 15.16 0.61
388 comp_sos_2_num_sm~~lid_2_num_sm 14.90 0.47
594 comp_sos_7_num_sm~~superv_3_num_sm 14.30 -0.79
741 covid_3_num_sm~~dllo_prof_3_num_sm 14.11 -0.70
308 fa3=~comp_ben_2_num_sm 14.02 0.34
300 fa3=~comp_sos_2_num_sm 13.92 0.30
736 covid_3_num_sm~~com_1_num_sm 13.82 -0.53
727 covid_2_num_sm~~com_1_num_sm 13.57 -0.50
735 covid_3_num_sm~~covid_4_num_sm 13.33 0.38
303 fa3=~comp_sos_6_num_sm 13.29 -0.32
704 ent_trab_2_num_sm~~covid_3_num_sm 12.81 -0.58
772 dllo_prof_1_num_sm~~com_2_num_sm 12.67 -0.59
593 comp_sos_7_num_sm~~superv_2_num_sm 12.42 -0.61
307 fa3=~intencion_1_num_sm 12.22 -0.32
692 lid_2_num_sm~~covid_3_num_sm 11.80 -0.59
319 fa3=~com_2_num_sm 11.67 0.27
470 comp_sos_6_num_sm~~covid_3_num_sm 11.47 -0.66
737 covid_3_num_sm~~comp_ben_1_num_sm 11.31 -0.47
691 lid_2_num_sm~~covid_2_num_sm 10.72 -0.51
494 comp_sos_8_num_sm~~covid_3_num_sm 10.56 -0.64
263 fa1=~covid_1_num_sm 10.07 -0.23
771 dllo_prof_1_num_sm~~dllo_prof_3_num_sm 9.94 -0.45
324 fa4=~comp_sos_5_num_sm 9.58 0.62
389 comp_sos_2_num_sm~~ent_trab_2_num_sm 9.38 0.38
765 comp_sos_4_num_sm~~dllo_prof_1_num_sm 9.37 -0.43
627 ges_des_1_num_sm~~superv_1_num_sm 9.03 -0.43
655 superv_1_num_sm~~dllo_prof_1_num_sm 8.63 -0.80
305 fa3=~comp_sos_9_num_sm 8.48 0.26
560 intencion_1_num_sm~~covid_3_num_sm 8.45 -0.58
770 dllo_prof_1_num_sm~~dllo_prof_2_num_sm 8.30 -0.42
536 lid_1_num_sm~~ent_trab_2_num_sm 8.13 0.45
717 covid_1_num_sm~~com_1_num_sm 8.07 -0.36
739 covid_3_num_sm~~dllo_prof_1_num_sm 7.83 -0.59
469 comp_sos_6_num_sm~~covid_2_num_sm 7.75 -0.50
732 covid_2_num_sm~~dllo_prof_3_num_sm 7.74 -0.45
629 ges_des_1_num_sm~~superv_3_num_sm 7.63 -0.54
728 covid_2_num_sm~~comp_ben_1_num_sm 7.63 -0.35
760 comp_ben_1_num_sm~~dllo_prof_1_num_sm 7.60 0.31
304 fa3=~comp_sos_8_num_sm 7.56 -0.23
459 comp_sos_6_num_sm~~comp_ben_2_num_sm 7.41 -0.28
493 comp_sos_8_num_sm~~covid_2_num_sm 7.41 -0.48
690 lid_2_num_sm~~covid_1_num_sm 7.01 -0.38
539 lid_1_num_sm~~covid_3_num_sm 6.50 -0.61
590 comp_sos_7_num_sm~~ent_trab_1_num_sm 6.15 -0.34
707 ent_trab_2_num_sm~~comp_ben_1_num_sm 5.90 -0.31
525 comp_sos_9_num_sm~~com_2_num_sm 5.81 -0.28
693 lid_2_num_sm~~covid_4_num_sm 5.79 -0.35
445 comp_sos_5_num_sm~~covid_3_num_sm 5.60 -0.43
726 covid_2_num_sm~~covid_4_num_sm 5.58 0.25
591 comp_sos_7_num_sm~~ges_des_1_num_sm 5.48 -0.25
670 superv_2_num_sm~~dllo_prof_1_num_sm 5.44 -0.69
758 com_1_num_sm~~ges_des_2_num_sm 5.42 0.25
376 comp_sos_2_num_sm~~comp_sos_6_num_sm 5.42 -0.30
561 intencion_1_num_sm~~covid_4_num_sm 5.13 -0.38
743 covid_3_num_sm~~ges_des_2_num_sm 5.10 -0.43
Nota. SEPC> +-1 en negrita
=~ : efecto de una variable observada en una variable latente
~~: covarianza entre los errores de dos variables observadas


Show code
loadings_a <- standardizedSolution(tot_4f_inicial) %>%  
  dplyr::filter(op == "=~", lhs == "fa1") %>% dplyr::select(est.std)
com_rel_a <- sum(loadings_a) ^ 2 / ((sum(loadings_a)^ 2)  + sum(1 - loadings_a ^ 2))  

loadings2_b <- standardizedSolution(tot_4f_inicial) %>%  
  dplyr::filter(op == "=~", lhs == "fa2") %>% dplyr::select(est.std)
com_rel_b <- sum(loadings2_b) ^ 2 / ((sum(loadings2_b)^ 2)  + sum(1 - loadings2_b ^ 2))  

loadings3_c <- standardizedSolution(tot_4f_inicial) %>%  
  dplyr::filter(op == "=~", lhs == "fa3") %>% dplyr::select(est.std)
com_rel_c <- sum(loadings3_c) ^ 2 / ((sum(loadings3_c)^ 2)  + sum(1 - loadings3_c ^ 2))  

loadings4_d <- standardizedSolution(tot_4f_inicial) %>%  
  dplyr::filter(op == "=~", lhs == "fa4") %>% dplyr::select(est.std)
com_rel_d <- sum(loadings4_d) ^ 2 / ((sum(loadings4_d)^ 2)  + sum(1 - loadings4_d ^ 2))  


avg_var_a <- sum(loadings_a ^ 2) / nrow(loadings_a)  
avg_var2_b <- sum(loadings2_b ^ 2) / nrow(loadings2_b)  
avg_var3_c <- sum(loadings3_c ^ 2) / nrow(loadings3_c)  
avg_var4_d <- sum(loadings4_d ^ 2) / nrow(loadings4_d)

cr_ave<-
  data.frame(
    Constructo=c("Identificación, proyección e involucramiento", "Supervisor inmediato", "Capacidad desiderativa y valórica de la empresa", "Formación e Información"),
    AVE=round(c(avg_var_a,avg_var2_b,avg_var3_c, avg_var4_d),2),
    CR=round(c(com_rel_a,com_rel_b,com_rel_c,com_rel_d),2)
  )

#Flora, D. B. (2020). Your Coefficient Alpha Is Probably Wrong, but Which Coefficient Omega Is Right? A Tutorial on Using R to Obtain Better Reliability Estimates. Advances in Methods and Practices in Psychological Science, 484–501. https://doi.org/10.1177/2515245920951747

#CR=El valor del estadístico debería ser superior a 0,7
#Reliability values at Levels 1 and 2 of the second-order factor, as well as the partial reliability value at Level 1
#estimates of ωu are unbiased with varying factor loadings (i.e., violation of tau equivalence), when alpha underestimates population reliability 

data.table(t(round(semTools::reliability(tot_4f_inicial, c("alpha.ord","omega","ave"),return.total=T),2)),keep.rownames = T) %>% 
  dplyr::mutate(rn=dplyr::case_when(rn=="fa1"~"Identificación, proyección e involucramiento",
                                    rn=="fa2"~"Supervisor inmediato",
                                    rn=="fa3"~"Capacidad desiderativa y valórica de la empresa",
                                    rn=="fa4"~"Formación e Información", T~"Total")) %>% 
  dplyr::left_join(cr_ave, by=c("rn"="Constructo")) %>% 
  knitr::kable(format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Tabla. Confiabilidad"),
               col.names = c("Constructo","Alfa ordinal", "omega", "Varianza Media Extraída/\nAverage variance extracted", "AVE", "Fiabilidad Compuesta"),
               escape=T)%>%
      kableExtra::add_footnote(c("Nota. AVE >0.5, evidencia de validez convergente; CR Alfa >=.7"),
                           notation = "none")%>%
  kableExtra::kable_classic(bootstrap_options = c("striped", "hover"),font_size = 12) %>%
  kableExtra::scroll_box(width = "100%", height = "375px")
(#tab:dls_afc_rel_2d)Tabla. Confiabilidad
Constructo Alfa ordinal omega Varianza Media Extraída/ Average variance extracted AVE Fiabilidad Compuesta
Identificación, proyección e involucramiento 0.95 0.91 0.66 0.66 0.95
Supervisor inmediato 0.94 0.93 0.79 0.79 0.96
Capacidad desiderativa y valórica de la empresa 0.96 0.95 0.80 0.80 0.97
Formación e Información 0.94 0.91 0.73 0.73 0.94
Total 0.98 0.98 0.74
Nota. AVE >0.5, evidencia de validez convergente; CR Alfa >=.7


Los resultados anteriores nos indican que la prueba muestra valores consistentes como un único constructo, iendo difícil distinguir entre ellos. De todas maneras, cada una de las dimensiones identificadas muestra una adecuada confiabilidad interna, lo que aporta evidencia de valdiez convergente aunque no de validez discriminante (a partir de la tabla previa a la indicada en el párrafo).


Aasland, M., Anders Skogstad, G. Notelaers, M. Nielsen, and S. Einarsen. 2010. The prevalence of destructive leadership behaviour.” British Journal of Management. https://doi.org/10.1111/j.1467-8551.2009.00672.x.
Andy Field. 2009. Discovering Statistics using SPSS Statistics.
Awang, Zainudin, Asyraf Afthanorhan, Mahadzirah Mohamad, and Iman Asri. 2016. “An Evaluation of Measurement Model for Medical Tourism Research: The Confirmatory Factor Analysis Approach.” International Journal of Tourism Policy 6 (January): 29. https://doi.org/10.1504/IJTP.2015.075141.
Barlett, M. 1937. Properties of sufficiency and statistical tests.” Proceedings of the Royal Society of London. Series A - Mathematical and Physical Sciences. https://doi.org/10.1098/rspa.1937.0109.
Carpenter, Serena. 2018. Ten Steps in Scale Development and Reporting: A Guide for Researchers.” Communication Methods and Measures 12 (1): 25–44. https://doi.org/10.1080/19312458.2017.1396583.
Cattell, Raymond B. 1966. The scree test for the number of factors.” Multivariate Behavioral Research. https://doi.org/10.1207/s15327906mbr0102_10.
Chen, Fang. 2007. “Sensitivity of Goodness of Fit Indexes to Lack of Measurement Invariance.” Structural Equation Modeling: A Multidisciplinary Journal 14 (3): 464–504. https://doi.org/10.1080/10705510701301834.
Cheung, Gordon W., and Roger B. Rensvold. 2002. “Evaluating Goodness-of-Fit Indexes for Testing Measurement Invariance.” Structural Equation Modeling: A Multidisciplinary Journal 9 (2): 233–55. https://doi.org/10.1207/S15328007SEM0902\_5.
Einarsen, S., H. Hoel, and G. Notelaers. 2009. Measuring exposure to bullying and harassment at work: Validity, factor structure and psychometric properties of the negative acts questionnaire-revised.” Work and Stress. https://doi.org/10.1080/02678370902815673.
Espinoza, Sergio Contreras, and Francisco Novoa-Muñoz. 2018. Advantages of ordinal alpha versus Cronbach’s alpha, illustrated using the WHO AUDIT testVantagens do alfa ordinal em relação ao alfa de Cronbach verificadas na pesquisa AUDIT-OMS TT - Ventajas del alfa ordinal respecto al alfa de Cronbach ilustradas con.” Revista Panamericana de Salud Publica = Pan American Journal of Public Health 42 (April): e65–65. https://doi.org/10.26633/RPSP.2018.65.
Fornell, Claes, and David F. Larcker. 1981. “Evaluating Structural Equation Models with Unobservable Variables and Measurement Error.” Journal of Marketing Research 18 (1): 39–50. https://doi.org/10.1177/002224378101800104.
Fox, J. 2019. polycor: Polychoric and Polyserial Correlations.”
Fox, John. 2019. “Polycor: Polychoric and Polyserial Correlations.” https://CRAN.R-project.org/package=polycor.
Hair, Joseph, William Black, Barry Babin, and Rolph Anderson. 2010. Multivariate Data Analysis: A Global Perspective.” In Multivariate Data Analysis: A Global Perspective.
Henseler, Jorg, Christian M Ringle, and Marko Sarstedt. 2015. A new criterion for assessing discriminant validity in variance-based structural equation modeling.” Journal of the Academy of Marketing Science 43 (1): 115–35. https://doi.org/10.1007/s11747-014-0403-8.
Hu, Li-tze, and Peter M Bentler. 1999. Cutoff criteria for fit indexes in covariance structure analysis: Conventional criteria versus new alternatives. Structural Equation Modeling 6 (1): 1–55. https://doi.org/10.1080/10705519909540118.
Izquierdo, Isabel, Julio Olea, and Francisco Jos+e Abad. 2014. Exploratory factor analysis in validation studies: uses and recommendations. Psicothema 26 (3): 395–400. https://doi.org/10.7334/psicothema2013.349.
Kline, Rex. 2013. Exploratory and confirmatory factor analysis.” In Applied Quantitative Analysis in Education and the Social Sciences. https://doi.org/10.4324/9780203108550.
Koo, T, and M Li. 2016. A Guideline of Selecting and Reporting Intraclass Correlation Coefficients for Reliability Research. Journal of Chiropractic Medicine 15 2: 155–63.
Leymann, H. 1990. Mobbing and psychological terror at workplaces. Violence and Victims. https://doi.org/10.1891/0886-6708.5.2.119.
Li, Cheng-Hsien. 2016. Confirmatory factor analysis with ordinal data: Comparing robust maximum likelihood and diagonally weighted least squares.” Behavior Research Methods 48 (3): 936–49. https://doi.org/10.3758/s13428-015-0619-7.
Liu, Ou Lydia, and Frank Rijmen. 2008. A modified procedure for parallel analysis of ordered categorical data.” Behavior Research Methods 40 (2): 556–62. https://doi.org/10.3758/BRM.40.2.556.
Lloret, Susana, Adoración Ferreres, Ana Hernández, and Inés Tomás. 2017. The exploratory factor analysis of items: Guided analysis based on empirical data and software. Anales de Psicología 33 (2): 417–32. https://doi.org/10.6018/analesps.33.2.270211.
Lloret-Segura, Susana, Adoración Ferreres-Traver, Ana Hernández-Baeza, and Inés Tomás-Marco. 2014. El Análisis Factorial Exploratorio de los Ítems: una guía práctica, revisada y actualizada .” scieloes.
MacCallum, Robert C, Michael W Browne, and Hazuki M Sugawara. 1996. Power analysis and determination of sample size for covariance structure modeling. Psychological Methods 1 (2): 130–49. https://doi.org/10.1037/1082-989X.1.2.130.
Marsh, Herbert W, and Dennis Hocevar. 1985. “Application of Confirmatory Factor Analysis to the Study of Self-Concept: First-and Higher Order Factor Models and Their Invariance Across Groups.” Psychological Bulletin 97 (3): 562.
Méndez Martínez, Carolina, and Martín Alonso Rondón Sepúlveda. 2012. Introducción al análisis factorial exploratorio.” Revista Colombiana de Psiquiatría 41 (1): 197–207. https://www.redalyc.org/articulo.oa?id=80624093014.
Mikkelsen, E., and S. Einarsen. 2001. Bullying in Danish work-life: Prevalence and health correlates.” European Journal of Work and Organizational Psychology. https://doi.org/10.1080/13594320143000816.
Osborne, Jason W, Anna B Costello, and J Thomas Kellow. 2008. Best Practices in Quantitative Methods.” Thousand Oaks, California: SAGE Publications, Inc. https://doi.org/10.4135/9781412995627.
Presaghi, Fabio, and Marta Desimoni. 2015. Title A Parallel Analysis With Polychoric Correlation Matrices. https://doi.org/10.13140/RG.2.1.4380.2640.
Raubenheimer, J. 2004. An item selection procedure to maximise scale reliability and validity.” Journal of Industrial Psychology 30 (4). https://doi.org/doi.org/10.4102/sajip.v30i4.168.
Revelle, Maintainer William. 2017. psych: Procedures for personality and psychological research (R package).” Evanston, Illinois: Northwestern University. https://cran.r-project.org/package=psych.
Rönkkö, Mikko, and Eunseong Cho. 2020. “An Updated Guideline for Assessing Discriminant Validity.” Organizational Research Methods 0 (0): 1094428120968614. https://doi.org/10.1177/1094428120968614.
Sakaluk, John K, and Stephen D Short. 2017. A Methodological Review of Exploratory Factor Analysis in Sexuality Research: Used Practices, Best Practices, and Data Analysis Resources. Journal of Sex Research 54 (1): 1–9. https://doi.org/10.1080/00224499.2015.1137538.
Streiner, David L. 2003. Starting at the beginning: An introduction to coefficient alpha and internal consistency.” Journal of Personality Assessment. https://doi.org/10.1207/S15327752JPA8001_18.
Tabachnick, Barbara G, Linda S Fidell, and Jodie B Ullman. 2007. Using Multivariate Statistics. Vol. 5. Pearson Boston, MA.
Treiblmaier, Horst, and Peter Filzmoser. 2010. Exploratory factor analysis revisited: How robust methods support the detection of hidden multivariate data structures in IS research.” Information & Management 47 (4): 197–207. https://doi.org/https://doi.org/10.1016/j.im.2010.02.002.
Viladrich, Carme, Ariadna Angulo-Brunet, and Eduardo Doval. 2017. A journey around alpha and omega to estimate internal consistency reliability.” Anales de Psicología 33 (3): 755–82. https://doi.org/10.6018/analesps.33.3.268401.
Whittaker, Tiffany A. 2012. Using the Modification Index and Standardized Expected Parameter Change for Model Modification.” The Journal of Experimental Education 80 (1): 26–44. https://doi.org/10.1080/00220973.2010.531299.
Worthington, Roger L, and Tiffany A Whittaker. 2006. Scale Development Research: A Content Analysis and Recommendations for Best Practices. Worthington, Roger L.: Department of Educational, School,; Counseling Psychology, University of Missouri, Columbia, MO, US, 65211, WorthingtonR@missouri.edu: Sage Publications. https://doi.org/10.1177/0011000006288127.
Yong, An, and Sean Pearce. 2013. A Beginner’s Guide to Factor Analysis: Focusing on Exploratory Factor Analysis.” Tutorials in Quantitative Methods for Psychology 9 (October): 79–94. https://doi.org/10.20982/tqmp.09.2.p079.
Zinbarg, Richard, William Revelle, I Yovel, and Wen Li. 2005. “Cronbach’s Alpha, Revelle’s Beta, and McDonald’s Omega h: Their Relations with Each Other and Two Alternative Conceptualizations of Reliability.” Psychometrika 70 (January): 123–33.

Compilación

Show code
save.image("__psicometrica_feb_2022.RData")

Información de la Sesión

Show code
Sys.getenv("R_LIBS_USER")
[1] "C:/Users/andre/Documents/R/win-library/4.1"
Show code
rstudioapi::getSourceEditorContext()
Document Context: 
- id:        '39FD359E'
- path:      'H:/Mi unidad/Clima_empresa/LCA_otros.Rmd'
- contents:  <1001 rows>
Document Selection:
- [932, 1] -- [952, 46]: '\nreshape2::melt(df2_cor_table2_LCA, id.vars=c(".class",".probability")) %>% \n    dplyr::group_by(variable, value,.class) %>% \n    dplyr::summarise(n=n()) %>% \n    dplyr::ungroup() %>% \n    dplyr::group_by(variable, value) %>% \n    dplyr::mutate(prob=n/sum(n)) %>% \n    dplyr::ungroup() %>% \nggplot(aes(x = .class, y = prob, fill = factor(value)))+\n    geom_bar(stat = "identity", position = "stack")+\n    facet_grid(variable ~ .)+ \n    scale_fill_brewer(type="seq", palette="Greys", na.value = "white")+\n    theme_bw()+\n    labs(y = "Percentage of Probabilities of Response", \n                  x = "Items",\n                  fill ="Cateorías de\\nRespuesta")+\n    theme( axis.text.y=element_blank(),\n                    axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1),\n                    axis.ticks.y=element_blank(),                    \n                    panel.grid.major.y=element_blank())+\n    guides(fill = guide_legend(reverse=TRUE)) <...>'
Show code
cbind.data.frame(label=data.frame(attr(unlist(sessionInfo()$R.version),"names")),data.table::data.table(unlist(sessionInfo()$R.version))) %>% 
  knitr::kable(format = "html", format.args = list(decimal.mark = ".", big.mark = ","),
               caption = paste0("Propiedades del documento"),
               col.names = c("Categoría","Valor"),
               align =c('l',rep('c', 101)),
               escape=T)%>%
    kableExtra::kable_classic(bootstrap_options = c("striped", "hover"),font_size = 12)
(#tab:session_info)Propiedades del documento
Categoría Valor
platform x86_64-w64-mingw32
arch x86_64
os mingw32
system x86_64, mingw32
status
major 4
minor 1.1
year 2021
month 08
day 10
svn rev 80725
language R
version.string R version 4.1.1 (2021-08-10)
nickname Kick Things
Show code
sessionInfo()$locale
[1] "LC_COLLATE=Spanish_Chile.1252;LC_CTYPE=Spanish_Chile.1252;LC_MONETARY=Spanish_Chile.1252;LC_NUMERIC=C;LC_TIME=Spanish_Chile.1252"
Show code
sessionInfo()$running
[1] "Windows 10 x64 (build 19042)"
Show code
sesion_info <- devtools::session_info()
dplyr::select(
  tibble::as_tibble(sesion_info$packages),
  c(package, loadedversion, source)
) %>% 
  DT::datatable(filter = 'top', colnames = c('Row number' =1,'Variable' = 2, 'Percentage'= 3),
              caption = htmltools::tags$caption(
        style = 'caption-side: top; text-align: left;',
        '', htmltools::em('Paquetes estadísticos utilizados')),
      options=list(
initComplete = htmlwidgets::JS(
      "function(settings, json) {",
      "$(this.api().tables().body()).css({'font-size': '80%'});",
      "}")))
Show code
unlink("*_cache", recursive = T, force = T, expand = TRUE)

References